Excelのこととか色々

マクロをどんな Excel ファイルにも実行できるように設定して、3秒かかる操作も1秒で完了。あといろいろ書いてみます・・・

【Excel/VBAのこと47】連続で選択したセルの範囲だけ操作する(取り消し線の付いている文字のみ削除)

   f:id:tuna-kichi:20200223230814p:plain

 

内部で使用する仕様書などの資料で、内容を更新する個所は削除せず、

取り消し線を付けて記載はそのまま残しておくものが多いです。

 

そのような資料を使用して作業する場合は、その取り消し線が非常に邪魔で、

どこが必要な個所かよくわからない場合があります。

 

しかも、使用するフォントによっては数字の「4」に取り消し線が付いているかどうかわからないものもあり、作業対象 or 対象外の判断を間違ってしまいます。

(間違ったことがありました・・・(-_-;))

 数字の4は取り消し線がわかりにくい

セルの内容全部に取り消し線が付いているのであれば無視するできるのですが、

一部分に取り消し線が付いているものが厄介です。

 

そこで、取り消し線のついている文字のみ削除するマクロを作成しました。

------------------------------------------------

 

下図のように9セルを選択した場合、この順番でセルに番号が振られます。

Selection(i) にして For loop で回せば1セルずつ操作できます。

 

 選択した範囲の Selection の順番

 

今回は、各セルのに入力されている文字を1文字ずつチェックして、

取り消し線が付いていなければ変数に格納し、新文字列としてセルに入力します。

つまり、取り消し線のついている文字のみ削除するのと同じ結果になります。

**********************************************

マクロ

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 ’削除しない1文字を格納する
 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 ’1文字ずつ取り消し線が付いているかチェックする
                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

**********************************************

 

これで、取り消し線の文字は無くなって、必要な個所のみ残ります。

 

このマクロでは、スペースに取り消し線が付いていなければ削除されず、

残ってしまうところがちょっと問題かもしれません。

マクロ実行後に内容を確認してください。

(私の取り扱う資料の場合は今のところ大丈夫なので、このマクロで十分です)

 

また、サーバーなどに置いて共有しているファイルに実行してしまうと

怒られてしまうので、ローカルにコピーしてから実行してください。

 

 

_/_/_/_/_/_/_/_/_/_/_/

 

 

 

個人用マクロブックについてはこちら

www.tuna-kichi.com

 

リボンに登録についてはこちら

www.tuna-kichi.com

 

 

_/_/_/_/_/_/_/_/_/_/_/_/_/_/

 

 

 

PVアクセスランキング にほんブログ村 Excelのこととか色々 - にほんブログ村 にほんブログ村 子育てブログ 幼稚園児育児へ にほんブログ村 英語ブログ 初心者英語へ にほんブログ村 IT技術ブログ VBAへ