Know-How-No-Life

Replaceメソッドを使うと 実行後のフォントは、すべて一文字目のフォントになってしまいます。

という内容の記事を以前書いたのですが、今回はその解決方法をひとつ

以前の記事は以下リンクよりご覧ください。

【VBA】Replaceメソッドは書式置換しないので注意

解決方法は、ずばり 『置換前の書式を保持しておく』というもの。

サンプルコードを書いてみたので、載せますね。

’╂━─━─━─━─━─━─━─━─━─━─━─━─━─━╂
’┃■書式を保持したままReplace
’┃
’┃@param schStr    検索文字列
’┃@param repStr    置換文字列
’╂━─━─━─━─━─━─━─━─━─━─━─━─━─━╂
Sub 書式を保持したままReplace(ByVal schStr As String, ByVal repStr As String)
    Dim schCell     As Range    ’ 検索セル
    Dim preCell     As Range    ’ 検索セル保持用
    Dim i           As Long     ’ セル文字列添え字
    Dim strLength   As Long     ’ セル文字列長

    ’ セルを検索する
    Set schCell = Sheet2.UsedRange.Find(What:=schStr, LookAt:=xlPart, MatchCase:=False, MatchByte:=False)
    ’ 書式を保持するためのセルを設定（※別シートなど影響のないセルにする）
    Set preCell = Sheet1.Range("A1")

    Do Until schCell Is Nothing
        ’ 元の書式を保持する
        schCell.Copy preCell
        ’ 置換実行
        schCell.Replace What:=schStr, Replacement:=repStr, LookAt:=xlPart, MatchCase:=False, MatchByte:=False
        ’ 文字列の長さを取得
        strLength = Len(schCell.Value)

        ’ フォントを元に戻す
        For i = 1 To strLength Step 1
            ’ フォントカラー
            schCell.Characters(i, 1).Font.ColorIndex = preCell.Characters(i, 1).Font.ColorIndex
’            schCell.Characters(i, 1).Font.Color = preCell.Characters(i, 1).Font.Color
            ’ 太字
            schCell.Characters(i, 1).Font.Bold = preCell.Characters(i, 1).Font.Bold
            ’ フォント
            schCell.Characters(i, 1).Font.FontStyle = preCell.Characters(i, 1).Font.FontStyle
            ’ 斜体
            schCell.Characters(i, 1).Font.Italic = preCell.Characters(i, 1).Font.Italic
            ’ サイズ
            schCell.Characters(i, 1).Font.Size = preCell.Characters(i, 1).Font.Size
            ’ 下線
            schCell.Characters(i, 1).Font.Underline = preCell.Characters(i, 1).Font.Underline
            ’ 影
            schCell.Characters(i, 1).Font.Shadow = preCell.Characters(i, 1).Font.Shadow
            ’ 取り消し線
            schCell.Characters(i, 1).Font.Strikethrough = preCell.Characters(i, 1).Font.Strikethrough
            ’ 上付き
            schCell.Characters(i, 1).Font.Subscript = preCell.Characters(i, 1).Font.Subscript
            ’ 下付き
            schCell.Characters(i, 1).Font.Superscript = preCell.Characters(i, 1).Font.Superscript
        Next i

        ’ 次のセルへ
        Set schCell = Sheet2.Cells.FindNext(schCell)
        ’ 書式を保持していたセルをクリア
        preCell.Clear
    Loop
    Set preCell = Nothing
End Sub

このプログラムを

Call 書式を保持したままReplace("青", "緑")

こんな感じで実行すると、以下の画像のようになります。

「青」という文字が…

「緑」に置換されます!!

ただし、このプログラムはちょっといけてないところがあって、

検索文字列と置換文字列の長さが違う場合はうまく置換できません

Call 書式を保持したままReplace("黄, "きいろ")

こんな感じ。

なんということでしょう。

書式がずれてしまいました。

これを解決させるためには、文字列の長さの差分をみる必要があります。

ただし、それをするにはある程度制約がかかることを知っておいてください。

以下のケース。つらいです。（よーく考えて。）

『 あいうえ お』

これを、『ひらがな』に置換するケース。

置換後の『ひらがな』の色はどうしましょう？

個人的な考えだと、実はそんなことは気にしません。

そもそもExcelって 『表計算ソフト』ですよね。

そんなWordみたいなセルの入力の仕方は、論理的でない気がするのでしないです。

Excelの入力の仕方は、以下であるべきだと思ってます。

そうすれば、いちいち書式を保持しておいて…とかしなくて済みますね

なるべくならめんどくさいロジックを書かなくてすむような書類にしておきたいものです。