小池イーサンだお(^O^)/

読んでーーーー

取消線のついた文字を削除するためのエクセルマクロを頑張って作ったはなし

やぁ、小池イーサンだよ(^O^)/

今日は取消線のついた文字を削除するためのエクセルマクロを頑張って作ったはなしをするよ。

やりたいことは上に書いた通り。
具体的なイメージはこんな感じ。
f:id:koike_e3:20161012204547p:plain

取消線をシコシコ手で消すのは面倒だし、
誤ってほかの部分を消してしまうかもしれない( ;∀;)
だから機械的にやりたいなって思ったワケ(´◉◞౪◟◉)
(要件の変更は取消線で訂正されていく社内文化なのである)

とりあえず書いてみよう

Sub 取消線を削除する()
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        'セル内の文字列を末尾から先頭に向かって調べていく
        For i = Len(moji.Value) To 1 Step -1
            'ひと文字ずつ判定し、取消線がついていれば削除する
            If moji.Characters(Start:=i, Length:=1).Font.Strikethrough = True Then
                moji.Characters(Start:=i, Length:=1).Delete
            End If
        Next i
    Next moji
End Sub

これでポチッとやってみたら動いた!!!
イーサン天才かよ(*‘ω‘ *)

しかし現実は甘くなかった

残念ながら次のような場合動かないことが分かった|д゚)
(右の数字は文字数)
f:id:koike_e3:20161012211510p:plain
文字数の少ないセルはうまくいっていたんだけど、
文字数の多いセルは削除されずに残ったままになっていたってワケ(´・ω・`)

他のマクロではこんなこと起こらなかったのになぁって思いながら
文字数が多くても処理できるソース読み返してみたの(*‘ω‘ *)

Sub 半角全角変換()
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        '半角を全角に変換する
        moji.Value = StrConv(moji.Value, vbWide)
    Next moji
End Sub

さっきはセル内の文字を処理(削除)していったけれど、
こっちはセルの内容を上書きしているって違いがあるなぁってわかったってワケ( `ー´)ノ

なるほど!上書きすればええんや( *´艸`)

改良してみよう

Sub 取消線を削除する2()
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        '取消線のついていない文字を結合していく変数の初期化
        temp = ""
        'セル内の文字列を末尾から先頭に向かって調べていく
        For i = Len(moji.Value) To 1 Step -1
            'ひと文字ずつ判定し、取消線がついていなければtempに結合
            If moji.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
                '末尾から調べているので先頭に結合していく
                temp = Mid(moji.Value, i, 1) & temp
            End If
        Next i
        moji.Value = temp
    Next moji
End Sub

これでめでたく削除できました(*‘ω‘ *)
f:id:koike_e3:20161012220514p:plain

おしまい(^O^)/