ExcelVBAについての質問です。
選択範囲内に任意文字コード範囲(添付画像の文字)が含まれていればセルの背景色を変えるようにしたいのですが
以下のコードでは文字コード範囲外のセルも塗りつぶされてしまいます。
どこに問題がありましょうか？
環境：WinXPpro Excel2010
Sub 抽出()
Dim c As Range
If Not TypeName(Selection) = "Range" Then Exit Sub
For Each c In Selection
If c Like "*[" & Chr(&HED40) & "-" & Chr(&HEEFC) & "]*" Then
c.Interior.ColorIndex = 15
End If
Next
End Sub
No.1
13539
1198
100pt
多分 文字コードが うまく取得できていないのだと思います。
ちょっと変えてみました。
Sub test() Dim c As Range e = "" For a = &HED40 To &HEEFC e = e + Chr(a) Next a If Not TypeName(Selection) = "Range" Then Exit Sub For Each c In Selection For d = 1 To Len(c) If InStr(1, e, Mid(c, d, 1)) > 0 Then c.Interior.ColorIndex = 15 Exit For End If Next d Next End Sub
No.1
135391198
ここでベストアンサー
100pt
多分 文字コードが うまく取得できていないのだと思います。
ちょっと変えてみました。
Sub test() Dim c As Range e = "" For a = &HED40 To &HEEFC e = e + Chr(a) Next a If Not TypeName(Selection) = "Range" Then Exit Sub For Each c In Selection For d = 1 To Len(c) If InStr(1, e, Mid(c, d, 1)) > 0 Then c.Interior.ColorIndex = 15 Exit For End If Next d Next End Sub
早速ありがとうございます。(_ _)
ほぼいけたのですが、なぜか中点(･)を含むセルも塗りつぶされました。
No.2
1314393
30pt
セルのコードは Unicode ですので シフトJIS のコードで処理をしたいのであれば、コード変換が必要だと思います。
Sub 抽出() Dim c As Range If Not TypeName(Selection) = "Range" Then Exit Sub For Each c In Selection If StrConv(c.Value, vbFromUnicode) Like "*[" & Chr(&HED40) & "-" & Chr(&HEEFC) & "]*" Then c.Interior.ColorIndex = 15 End If Next End Sub
としてみてどうでしょうか。
ありがとうございます。
結果は当方コードと同じ結果で、文字コード範囲外のセルが塗りつぶされました。
No.3
26251149
50pt
2010が手近になくコメントにしたかったのですが、コメント・トラックバックは表示しておられないので回答欄で失礼します
下記のような具合で試してみてください
（古いExcelだと質問文のとおりで動きます。2007から中身が微妙に変わってるようで、いろいろ試してみるしかないようです）
If (c Like "*[" & Chr(&HED40) & "-" & Chr(&HEEFC) & "]*") = True Then
＞なぜか中点(･)を含むセルも塗りつぶされました
id:takntさんのコードだとEEEDとEEEEを含んでいるために質問文添付画像のように中黒（・）がリストアップされてしまいます
For a = &HED40 To &HEEEC e = e + Chr(a) Next a For a = &HEEEF To &HEEFC e = e + Chr(a) Next a
ありがとうございます。
中点の件了解しました。
For a = &HED40 To &HEEEC
e = e + Chr(a)
Next a
For a = &HEEEF To &HEEFC
e = e + Chr(a)
Next a
msgbox e
で、すべての外字が取得されませんでしたが
e = ""
For a = &HED40 To &HED7E
e = e + Chr(a)
Next a
For a = &HED80 To &HEDFC
e = e + Chr(a)
Next a
For a = &HEE40 To &HEE7E
e = e + Chr(a)
Next a
For a = &HEE80 To &HEEEC
e = e + Chr(a)
Next a
としたところ、全ての外字が取得できました。
Mook
2011/05/02 20:36:42
1
2
1
2
1
36
32
早速ありがとうございます。(_ _)
ほぼいけたのですが、なぜか中点(･)を含むセルも塗りつぶされました。