取り消し線が設定された範囲の文字を除去したい

先日、こんな相談を受けた。

「Excelで、文字列の一部に取り消し線が設定されているのですが、
その部分だけ除去して別のセルにコピーできませんか？」

ということで、挑戦してみた。

依頼内容を視覚化すると、↓ こんな感じだ。

1. 取り消し線が付された文字を除去したい。
2. 文字が全て除去された行は、改行も除去したい。
3. 余分な改行も除去したい。

作成したものから、上記内容のみ抜き出して再構築したのがこちら。

Sub 取消範囲除去(src_range As Range, _
                 dst_range As Range)
    ' 取消範囲除去前の文字列。
    Dim Src As String
        Src = src_range.Value
    ' 除去後の文字列格納用変数。
    Dim Dst As String
    Dim i As Long
        ' 取り消し線が付されていない文字のみ、
        ' Dstへ追加する（※改行も含まれる）。
        For i = 1 To Len(Src)
            If Not src_range.Characters(i, 1) _
                        .Font.Strikethrough Then
                Dst = Dst & Mid(Src, i, 1)
            End If
        Next
        
        ' 正規表現。
    Dim myReg As Object
    Set myReg = CreateObject("VBScript.RegExp")
        ' ２回以上連続する改行でマッチ。
        myReg.Pattern = "\n{2,}"
        myReg.Global = True
        
        ' ２回以上連続する改行を一つの改行に置き換える
        ' ことで、全ての文字が除去された行を削除する。
        If myReg.Test(Dst) Then
            Dst = myReg.Replace(Dst, vbNewLine)
        End If
        
        dst_range = Dst
End Sub

実行した結果がこちら。

依頼をくださった方に渡したところ、大変喜んでもらえたので良かった。

参考まで。