フィールド内の各レコードの値によってセルを塗り分ける方法

質問

私の質問を拝読いただき、ありがとうございます。
マトリックス形式のデータがワークシートに埋め込まれています。
特定のフィールドに入っている各レコードのデータをエクセルで検査するマクロを作ろうとしています。
検査方法としては、一定量以上の文字列が入っているセルを特定の色で塗るというものです。
（条件付書式でも同じことが可能ですが、操作の関係上、マクロで実現したいものです。）

次のようなコードを実行すると、各セル内の文字量が80文字を超えていようがいまいが、
B列の全てのセルがcolor=7で塗りつぶされてしまいます。

------------------------------------
Private Sub 検査()

Dim objColumn As String
Dim objCell As Range
Dim mojiByt As Integer

i = 2
objColumn = Columns(i).Address
For Each objCell In Range(objColumn)
With objCell
mojiByt = LenB(.Value)
Select Case mojiByt
Case Is > 80
.Interior.Color = 7
Case Else
.Interior.Color = xlNone
End Select
End With
Next
End Sub
------------------------------------

このコードのエラーをご指摘いただきますと幸いです。
よろしくお願い致します。

回答No.1

OtenkiAme · ベストアンサー

こんにちは。

ColorプロパティにはRGB関数で色を指定します。
.Interior.Color　を　.Interior.ColorIndex　に修正するか、
又は、
= 7　を　RGB(255, 0, 255)　に修正してみてください。

なお、
.Interior.Color = xlNone　の　xlNone　を　RGB(255, 255, 255) 　に
してしまうと、枠線も白く塗りつぶされてしまいますので、こちらは、
Color　を　ColorIndex　にした方がよいと思います。

また、一つずつのセルに背景色を設定するのではなく、最初にすべての
セルを塗りつぶしなしにしてから該当するセルだけ色を付けた方が速く
なります。（列全体で指定されているので範囲を絞り込めれば、もう少し
速く処理できると思います。）

Private Sub 検査()

Dim objColumn As String
Dim objCell As Range
Dim mojiByt As Long
Dim i As Long

i = 2
objColumn = Columns(i).Address
For Each objCell In Range(objColumn)
　　With objCell
　　　　mojiByt = LenB(.Value)
　　　　Select Case mojiByt
　　　　　　Case Is > 80
'　　　　　　　　.Interior.Color = RGB(255, 0, 255)
　　　　　　　　.Interior.ColorIndex = 7
　　　　　　Case Else
'　　　　　　　　.Interior.Color = RGB(255, 255, 255)
　　　　　　　　.Interior.ColorIndex = xlNone
　　　　End Select
　　End With
Next
End Sub

Private Sub 検査2()

Dim objColumn As String
Dim objCell As Range
Dim mojiByt As Long
Dim i As Long

i = 2
objColumn = Columns(i).Address

Range(objColumn).Interior.ColorIndex = xlNone

For Each objCell In Range(objColumn)
　　If LenB(objCell.Value) > 80 Then
　　　　objCell.Interior.Color = RGB(255, 0, 255)
'　　　　objCell.Interior.ColorIndex = 7
　　End If
Next
End Sub

お礼

貴重なご意見、ありがとうございました。コードをきちんと検証してくださり、ありがとうございます。ご提案いただいたコードを試すことができましたので、自分の思い違いなどを確認させていただくことができました。非常にありがたいご回答をいただきまして、感謝しております。

回答No.5

myRange

回答３、myRangeです。
回答３で提示したサイトを覗いてみましたか？
ふつうに読めばそこに答えがあることが分かると思うのですが、
にも拘わらず

＞80文字は80byteの誤りです

との文言。
これは提示のサイトを覗いていないということですね？

そこには次のようなことが書いてあります。　
例えば、
対象文字列を「あa」とした場合。（但し、a は半角）

　LenB("あa")　⇒　４
　LenB(StrConv("あa", vbFromUnicode))　⇒　３

さて、質問者はどちらのバイト数を取得したいのでしょうか。　
いま一度、提示したサイトを覗いてみたらどうでせう。
以上です。

お礼

URL内の記事の解説をいただき、どこにポイントを置いて読み込めばいいかアドバイスをいただき、大変ありがたく思います。

回答No.4

rivoisu

だったらステップ実行してみながら変数が自分の意図したようになっているかCheckしてみましょう。
デバッグの基本です。
どこに問題があるか絞れるから。
このコードをみる限りまた質問者の言うとおり長さの条件も間違っていないのならcell内の文字列の長さが80Byte以上あるのでしょう。
データの方をチェックしましょう。長い空白が入っていませんか？

本当にこのコードをテストしたのですか
６５５３６回のループになりますよ。
どのくらいかかりました？

またこのコードには無駄が多い
i = 2
objColumn = Columns(i).Address
For Each objCell In Range(objColumn)

結局
For Each objCell In Range("B:B")
と同じでしょ
i を変数にしそのrangeからアドレス文字列を取り出し、それでまたrangeを指定する。
このコードだとB列の全部のcellをみるから６５５３６回のループになる
本当にそれでいいのかな

条件で2つに分けるだけならIf文が常道でなぜCase文を使うかわからない。

どこかから拾ってきたコードをよく読まずに（意味を調べずに）使っているのでしょうか

お礼

お忙しい中、ご回答、ありがとうございました。専門家でいらっしゃるということで、貴重なアドバイスに感謝しております。
コードの無駄につきまして、説明不足でご面倒をお掛けしました。コードの運用方法に変更の可能性があるため、他の列、他の判定要素を入れられるようなコード記述とさせていただきました。
ループは確かに時間が掛るものでして、おそらく、コンピュータのスペックにもよると思うのですが、ほぼ、ブランクデータの65536ループで10秒程度要しました。事前にデータの総レコードを入力させるなどして、検査ターゲットを絞り込ませるようなコードにすべきと思いました。
貴重なご意見、ありがとうございました。

回答No.3

myRange

LenB　を　Len　に変えてみましょう。

　mojiByt = Len(.Value)

●下記マイクロソフトサイトを一読することをお勧めします。

http://support.microsoft.com/default.aspx?scid=kb%3Bja%3BJP408879

Colorプロパティの件は既出の回答で指摘さてるので省略
以上です。

お礼

お忙しい中、迅速なアドバイスをいただき、ありがとうございました。URLのご紹介により、研鑽を深めることができました。

補足

ご回答ありがとうございます。質問が悪く、申し訳ございません。80文字は80byteの誤りです。よろしくお願いします。

回答No.2

rivoisu

lenBだと41字で80Byteを越えちゃいますよ
それでいいのですか？
質問文の中で「文字数」とあるのでlenのほうじゃないですか

ステップ実行してmojiBytがいくつになるか見てください。あなたの思ったとおりの数字になっていますか？

すみません余計なことかも知れませんがデバッグの方法をきちんと覚えておかれたほうがいいですよ。この欄の質問にあまりにも自分で検証したことがない人が多いので

お礼

専門家でいらっしゃるということで、貴重なアドバイスに感謝しております。セル内のデータ量を検査するものでして、lenbを使いたかったのですが、「文字数」という適切でない言葉を使用したため、ご面倒をお掛けしました。お忙しい中、ご回答、ありがとうございました。

補足

ご回答ありがとうございます。質問が悪く、申し訳ございません。80文字と書かせていただいている部分は、80byteの誤りです。よろしくお願いします。