内部で使用する仕様書などの資料で、内容を更新する個所は削除せず、
取り消し線を付けて記載はそのまま残しておくものが多いです。
そのような資料を使用して作業する場合は、その取り消し線が非常に邪魔で、
どこが必要な個所かよくわからない場合があります。
しかも、使用するフォントによっては数字の「４」に取り消し線が付いているかどうかわからないものもあり、作業対象 or 対象外の判断を間違ってしまいます。
（間違ったことがありました・・・(-_-;)）
セルの内容全部に取り消し線が付いているのであれば無視するできるのですが、
一部分に取り消し線が付いているものが厄介です。
そこで、取り消し線のついている文字のみ削除するマクロを作成しました。
------------------------------------------------
下図のように9セルを選択した場合、この順番でセルに番号が振られます。
Selection(i) にして For loop で回せば１セルずつ操作できます。
今回は、各セルのに入力されている文字を１文字ずつチェックして、
取り消し線が付いていなければ変数に格納し、新文字列としてセルに入力します。
つまり、取り消し線のついている文字のみ削除するのと同じ結果になります。
**********************************************
マクロ
Sub 取り消し線文字のみ削除()
Dim Target As Range '選択した範囲のチェックするセル
Dim i As Long
Dim LastCell As Long '選択した範囲最後のセル
Dim NewText As String ’削除しない文字列を格納する
Dim w As Long ’チェックするセルの文字のループに使用
Dim x As String ’削除しない１文字を格納する
Dim LastLetter As Long ’チェック対象セルの文字数を格納する
LastCell = Selection.Count ’選択した範囲のセル数を数える
For i = 1 To LastCell ’選択範囲のループ
If Selection(i) <> "" Then
Set Target = Selection(i) ’チェック対象のセルを格納する
LastLetter = Len(Selection(i)) ’チェック対象セルの文字数を格納する
For w = 1 To LastLetter ’１文字ずつ取り消し線が付いているかチェックする
If Target.Characters(Start:=w, Length:=1).Font.Strikethrough = False Then
x = Mid(Target, w, 1) ’取り消し線が付いていなければNewTextに格納する
NewText = NewText & x
End If
Next w
Selection(i) = NewText ’取り消し線が付いていない文字のみセルに入力する
End If
Next i
End Sub
**********************************************
これで、取り消し線の文字は無くなって、必要な個所のみ残ります。
このマクロでは、スペースに取り消し線が付いていなければ削除されず、
残ってしまうところがちょっと問題かもしれません。
マクロ実行後に内容を確認してください。
（私の取り扱う資料の場合は今のところ大丈夫なので、このマクロで十分です）
また、サーバーなどに置いて共有しているファイルに実行してしまうと
怒られてしまうので、ローカルにコピーしてから実行してください。
＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／
個人用マクロブックについてはこちら
リボンに登録についてはこちら
＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／
