|
↑のコードは文字色のみ考慮したもので不備がありました。
文字色、太文字、斜字体の3点を考慮した改造版です。
Sub test()
Dim mycell As Range
Dim sagyoucell As Range
Dim cellstr As String
Dim i As Long
Dim j As Long
Set sagyoucell = ActiveSheet.Cells(1, 1)
Set mycell = ActiveCell
cellstr = ""
For i = 1 To Len(mycell.Value)
If i < 2 Or i > 2 + 2 - 1 Then cellstr = cellstr & Mid(mycell.Value, i, 1)
Next i
With sagyoucell
.NumberFormatLocal = "@"
.Value = cellstr
End With
j = 0
For i = 1 To Len(mycell.Value)
If i < 2 Or i > 2 + 2 - 1 Then
j = j + 1
With sagyoucell.Characters(Start:=j, Length:=1).Font
.Color = mycell.Characters(Start:=i, Length:=1).Font.Color
.Bold = mycell.Characters(Start:=i, Length:=1).Font.Bold
.Italic = mycell.Characters(Start:=i, Length:=1).Font.Italic
End With
End If
Next i
sagyoucell.Copy mycell
sagyoucell.Clear
Set sagyoucell = Nothing
Set mycell = Nothing
End Sub
|
|