エクセルで半角文字に色を付けるVBA

質問

エクセルで半角文字を全角に変換しつつ、変換した文字には色を付けるマクロを考えています。

半角→全角の変換はこの記述でできましたが、

myTEXT = StrConv(myTEXT, vbWide)

変換した文字（変換後の文字）に色を付ける、というのが分かりません・・・。

そのような記述は可能でしょうか？お時間あるときにでもご教授いただけると助かります。

回答No.2

Wendy02 · ベストアンサー

こんにちは。

こんな風にしたらどうでしょうか。

Sub TestExchange1()
Dim c As Range
Dim rng As Range
　Set rng = ActiveSheet.UsedRange
　For Each c In rng
　 If VarType(c.Value) = vbString Then　'二重になっているけれどやむをえない
　　　 strFind c
　 End If
　Next c
　Set rng = Nothing
End Sub
Function strFind(ByRef rng As Range)
　　Dim Matches As Object
　　Dim Match As Object
　　Dim strTxt As String
　　Dim Ar(1, 254) As Integer
　　Dim n As Integer
　　With CreateObject("VBScript.RegExp")
　　　　.Pattern = "([!-~\uFF61-\uFF9F]+)"
　　　　.Global = True
　　　　If VarType(rng.Value) = vbString Then
　　　　　　strTxt = rng.Value
　　　　　　If .Test(strTxt) Then
　　　　　　　　Set Matches = .Execute(strTxt)
　　　　　　　　For Each Match In Matches
　　　　　　　　　　Ar(0, n) = Match.firstindex + 1
　　　　　　　　　　Ar(1, n) = Match.Length
　　　　　　　　　　n = n + 1
　　　　　　　　　　strTxt = Replace(strTxt, Match.Value, StrConv(Match.Value, vbWide), , 1, vbBinaryCompare)
　　　　　　　　　　rng.Value = strTxt
　　　　　　　　Next
　　　　　　End If
　　　　End If
　　End With
　　n = 0
　　Do Until Ar(0, n) = 0
　　　　rng.Characters(Ar(0, n), Ar(1, n)).Font.ColorIndex = 3
　　　　n = n + 1
　　Loop
　　Erase Ar()
End Function

お礼

なるほどー。長い回答ありがとうございます。非常に勉強になります。

こちらでも試してみます！ありがとうございました！

回答No.1

merlionXX

myTEXT = StrConv(myTEXT, vbWide)　と文字列変数を一括で全角に変換するということは全角半角の混在は考えなくとも良いのですね？
ならば、
変換前後のバイト数を調べて変わっていれば半角だったとわかります。

Sub Test01()
myText = "abc"
x = LenB(StrConv(myText, vbFromUnicode))
myText = StrConv(myText, vbWide)
y = LenB(StrConv(myText, vbFromUnicode))
If y > x Then
MsgBox "myTextは半角文字が含まれていました."
'色を変えるコード
End If
End Sub

お礼

変換前後のバイト数を調べるというのは思いつきませんでした。勉強になりました。ありがとうございます！