回答編集履歴

1

追記

2019/03/01 00:43

投稿

ttyp03
ttyp03

スコア17000

test CHANGED
@@ -57,3 +57,141 @@
57
57
 
58
58
 
59
59
  ```
60
+
61
+
62
+
63
+ 追記
64
+
65
+ なんか気になって寝ながらコードを考えたので書いてみました。
66
+
67
+ 参考まで。
68
+
69
+ ```VBA
70
+
71
+ Public Sub removeStrikethrough()
72
+
73
+
74
+
75
+ Debug.Print Now
76
+
77
+
78
+
79
+ Application.DisplayAlerts = False
80
+
81
+
82
+
83
+ Dim tmpRange As Range
84
+
85
+ Dim i, j, tmpLength As Long
86
+
87
+
88
+
89
+ Dim ash As Worksheet ' セルが選択されているシート
90
+
91
+ Dim wsh As Worksheet ' 作業用シート
92
+
93
+ Dim wrg As Range ' 作業用セル
94
+
95
+
96
+
97
+ Set ash = ActiveSheet
98
+
99
+ Set wsh = ActiveWorkbook.Worksheets.Add
100
+
101
+ Set wrg = wsh.Cells(1, 1)
102
+
103
+ ash.Select
104
+
105
+
106
+
107
+ For Each tmpRange In Selection
108
+
109
+
110
+
111
+ tmpLength = Len(tmpRange.MergeArea(1).Value)
112
+
113
+
114
+
115
+ ' 対象セルを作業用セルにコピー
116
+
117
+ tmpRange.Copy wrg
118
+
119
+
120
+
121
+ ' 取消し線以外の文字を収集
122
+
123
+ tmpv = ""
124
+
125
+ For i = 1 To tmpLength
126
+
127
+ With wrg.Characters(i, 1)
128
+
129
+ If Not .Font.Strikethrough Then
130
+
131
+ tmpv = tmpv & .Caption
132
+
133
+ End If
134
+
135
+ End With
136
+
137
+ Next
138
+
139
+
140
+
141
+ ' 取消し線以外の文字で更新
142
+
143
+ tmpRange.Value = tmpv
144
+
145
+
146
+
147
+ ' 取消し線以外の文字のフォント情報をコピー
148
+
149
+ j = 1
150
+
151
+ For i = 1 To tmpLength
152
+
153
+ With wrg.Characters(i, 1)
154
+
155
+ If Not .Font.Strikethrough Then
156
+
157
+ tmpRange.Characters(j, 1).Font.Bold = .Font.Bold
158
+
159
+ tmpRange.Characters(j, 1).Font.Color = .Font.Color
160
+
161
+ tmpRange.Characters(j, 1).Font.ColorIndex = .Font.ColorIndex
162
+
163
+ tmpRange.Characters(j, 1).Font.FontStyle = .Font.FontStyle
164
+
165
+ tmpRange.Characters(j, 1).Font.Italic = .Font.Italic
166
+
167
+ tmpRange.Characters(j, 1).Font.Size = .Font.Size
168
+
169
+ tmpRange.Characters(j, 1).Font.Underline = .Font.Underline
170
+
171
+ j = j + 1
172
+
173
+ End If
174
+
175
+ End With
176
+
177
+ Next
178
+
179
+ Next tmpRange
180
+
181
+
182
+
183
+ wsh.Delete
184
+
185
+
186
+
187
+ Application.DisplayAlerts = True
188
+
189
+
190
+
191
+ Debug.Print Now
192
+
193
+
194
+
195
+ End Sub
196
+
197
+ ```