セルの書式を変えずにReplace
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
以上は、http://blog.livedoor.jp/vba_performance/archives/3402128.htmlから引用しました。とても勉強になりました。