置換したら、置換後の文字に訂正線が拡張されてしまう現象 ①

昨日は複数セルを対象に、複数の文字を一括置換しつつ、置換前の文字は訂正線を引いて残しておくことに挑戦した。
infoment.hatenablog.com

前回、前々回の処理を行ううえでの大前提は、対象となるセルが置換前の文字と完全一致すること。従って、置換前以外の文字が含まれていた場合、前回までのマクロでは成立しない。

さらに、このような現象が起きることも分かった。
例えば ↓ のセルに対して、「林檎」を「ばなな」に置換してみる。

すると、「林檎」には無かった訂正線が、林檎と置換した「ばなな」に現れてしまった。これでは、都合が悪い場合もあるだろう。ということで色々と、この辺りを模索してみたい。

まず今回は、↓ がどのように構成されているか、確認してみることにした。

Sub test_2()

    ' A1セル内の文字と訂正線の情報を格納するために、
    ' 二次元配列を準備する。
    Dim arr() As Variant
    ReDim arr(1 To Range("A1").Characters.Count, 1 To 2)

    ' 一文字ずつ、文字情報と訂正線の情報を取得して
    ' 配列に格納する。
    Dim i As Long
        For i = 1 To Range("A1").Characters.Count
            With Range("A1").Characters(i, 1)
                arr(i, 1) = .Text
                arr(i, 2) = .Font.Strikethrough
            End With
        Next

    ' 格納した情報をシートに貼り付け。
        Range("A3").Resize(UBound(arr), UBound(arr, 2)) = arr

End Sub

Excelのバージョンによって違う結果が出たので（私の端末に限り？）、これに伴い、訂正線を引くマクロも次のように改修した。

Sub CorrectCharacter(target_range As Range, _
                     source_chara As String, _
                     corrected_chara As String)
    ' 文字列の結合
        target_range = source_chara & vbNewLine & corrected_chara
    
    ' 先頭から訂正前までの文字列分、訂正線を追加する。
    ' それ以降の文字から、訂正線を除去する。
        With target_range
            .Characters(Start:=1, Length:=Len(source_chara)).Font.Strikethrough = True
            .Characters(Start:=Len(source_chara) + 1, _
                               Length:=.Characters.Count - Len(source_chara)).Font.Strikethrough = False
        End With
        
End Sub

確認した結果、このようになった。
※A6には、「改行」が入っている。

では、この情報をそのままＢ１セルに返してみる。

Sub test_2()

    ' A1セル内の文字と訂正線の情報を格納するために、
    ' 二次元配列を準備する。
    Dim arr() As Variant
    ReDim arr(1 To Range("A1").Characters.Count, 1 To 2)

    ' 一文字ずつ、文字情報と訂正線の情報を取得して
    ' 配列に格納する。
    Dim i As Long
        For i = 1 To Range("A1").Characters.Count
            With Range("A1").Characters(i, 1)
                arr(i, 1) = .Text
                arr(i, 2) = .Font.Strikethrough
            End With
        Next

    ' 格納した情報をシートに貼り付け。
        Range("A3").Resize(i - 1, 2) = arr

    ' arrに格納した情報で、B1セルに文字入力。
        For i = 1 To UBound(arr)
            With Range("B1").Characters(i, 1)
                .Text = arr(i, 1)
                .Font.Strikethrough = arr(i, 2)
            End With
        Next

End Sub

これらを踏まえ、番地と文字列決め打ちではあるが、「林檎」を「ばなな」に置き換えたうえでＢ１セルに入力してみた。

Sub test_2()

    ' A1セル内の文字と訂正線の情報を格納するために、
    ' 二次元配列を準備する。
    Dim arr() As Variant
    ReDim arr(1 To Range("A1").Characters.Count + 1, 1 To 2)

    ' 一文字ずつ、文字情報と訂正線の情報を取得して
    ' 配列に格納する。
    Dim i As Long
        For i = 1 To Range("A1").Characters.Count
            With Range("A1").Characters(i, 1)
                arr(i, 1) = .Text
                arr(i, 2) = .Font.Strikethrough
            End With
        Next
        
    ' 林檎をばななに置き換える
        arr(5, 1) = "ば": arr(5, 2) = False
        arr(6, 1) = "な": arr(6, 2) = False
        arr(7, 1) = "な": arr(7, 2) = False
        

    ' 格納した情報をシートに貼り付け。
        Range("A3").Resize(7, 2) = arr

    ' arrに格納した情報で、B1セルに文字入力。
        For i = 1 To UBound(arr)
            With Range("B1").Characters(i, 1)
                .Text = arr(i, 1)
                .Font.Strikethrough = arr(i, 2)
            End With
        Next

End Sub

結果、このようになった。

さて、これをどのように一般化していくか。次回に続きます。

参考まで。