文字の書式（Characters）

A1内の文字に設定されている書式を他にもコピーしたい。

ネットで検索すると255文字だか256文字を超えた場合に書式が壊れるとか何とか出てきますが、そこまでテストしません。数文字でもおかしくなります。Excelは表計算ソフトです。自己責任。

Sub 選択部に書式コピー()
    
    Dim i As Integer
    Dim r As Range
    Dim c As Characters
    
    Dim 書式 As Range
    Set 書式 = Range("A1") '書式コピー元
    
    For Each r In Selection
        
        For i = 1 To Len(r.Value)
            
            Set c = 書式.Characters(Start:=i, Length:=1)
            If c.Text = "" Then Exit For
            
            With r.Characters(Start:=i, Length:=1).Font
                .Bold = c.Font.Bold '太字
                .Color = c.Font.Color '文字色
                .Italic = c.Font.Italic '斜体
                .Name = c.Font.Name 'フォント
                .Size = c.Font.Size '文字サイズ
                .Underline = c.Font.Underline '下線
                .Strikethrough = c.Font.Strikethrough '取消線
                .Superscript = c.Font.Superscript '上付文字
                .Subscript = c.Font.Subscript '下付文字
            End With
            
        Next
        
    Next
    
End Sub

Sub 書式クリア()
    With Selection
        .ClearFormats
        .Value = .Value
    End With
End Sub

Excelは表計算ソフトです。

以上。