エクセルＶＢＡでセルに色を付けるには

質問

エクセル2010の質問です。
例えばＡ列に入力した文字のバイト数が38より多い場合、セルに色を付けたいのです。

条件付き書式で　=LENB($A2:$A1048576)>38　でもよかったのですが
シート内のデータをクリアすると条件付き書式までクリアされてしまい困っています。

ＶＢＡで出来るのが一番なのかなと思っていますが、ご教授お願い致します。

回答No.5

cj_mover · ベストアンサー

＃２、ｃｊです。補足欄へのレスです。

> 最初の質問後に追加がありまして、
> Ａ列に入力した文字数のバイト数が38よりも多い場合にセルに色を付けて、
> さらに、I列に入力した文字のバイト数が24より多い場合もセルに色を付けたいのです。
> 色々試してみましたが、上手く出来ません。
結構難しいことをしようとしていますから、うまく出来なくても無理ないです。
＃２から考えると、基本設計から変えないと対応出来ませんね。
ということで、書き直しました。

　　今後も列を増やすことがあるかも知れませんから、
　　各ブロック（列）ごとに構文を揃えてあります。
　　' ' Ａ列ーーーーーーーー
　　から
　　' ' ーーーーーーーーーー
　　まで
　　をコピーしたものを貼り付けて
　　▼列の指定、■バイト数の指定、★色の指定、
　　の３カ所（見出しの列名も含めれば４カ所）書き換えてみてください。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝シートモジュール＝＝＝＝＝＝＝＝＝＝＝＝

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim rPrSum As Range
　　Dim r As Range

　　' ' Ａ列ーーーーーーーー
　　Set rPrSum = Intersect(Target, Range("A:A"))　　'　　▼列の指定
　　If Not rPrSum Is Nothing Then
　　　　For Each r In rPrSum
　　　　　　If LenB(StrConv(r.Value, vbFromUnicode)) > 38 Then　　'　　■バイト数の指定
　　　　　　　　r.Interior.Color = &H6699FF　　'　　★色の指定
　　　　　　Else
　　　　　　　　r.Interior.ColorIndex = xlColorIndexNone
　　　　　　End If
　　　　Next
　　End If
　　' ' ーーーーーーーーーー

　　' ' Ｉ列ーーーーーーーー
　　Set rPrSum = Intersect(Target, Range("I:I"))　　'　　▼列の指定
　　If Not rPrSum Is Nothing Then
　　　　For Each r In rPrSum
　　　　　　If LenB(StrConv(r.Value, vbFromUnicode)) > 24 Then　　'　　■バイト数の指定
　　　　　　　　r.Interior.Color = &H6699FF　　'　　★色の指定
　　　　　　Else
　　　　　　　　r.Interior.ColorIndex = xlColorIndexNone
　　　　　　End If
　　　　Next
　　End If
　　' ' ーーーーーーーーーー

　　Set rPrSum = Nothing
End Sub

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

理解に自信持てなさそうな関数、メソッド、プロパティなどがもしあれば、
VBE画面上で、各キーワードにカーソルを当てて、F1 キーを押すなどして、
ＶＢＡのヘルプの内容程度は、浚っておいてください。

今回課題の色付け対象セルを.Clearメソッドで
値消去する場合は、そちらのマクロの記述に関して
　　Application.EnableEvents = False
　　範囲.Clear
　　Application.EnableEvents = True
のように、前後に書き加えた方が、無駄な処理をせずに済みますし、
思わぬ結果になってしまうことを避ける意味もありますし、何かとトラブルを減らせます。
　　イベントの発行を抑止して、
　　クリアして、
　　イベントの発行を再開
という意味なのですが、範囲.Clearを実行時には、
上記Private Sub Worksheet_Changeを実行させなくていい（させない方がいい）
ということです。

以下、蛇足になりますが、、、。
システムのデザインの面で妥協点を見つけられるのであれば、
ＶＢＡで色付けする代りに条件付き書式で対応する方が簡単で管理しやすい、
（なるべくシートイベントに頼らないほうがいい）
というのは、私も賛同できる考え方です。
でも例えば、他のアプリケーションからコピペしたものなどは、
背景色以外の様々な書式設定を踏襲することを避ける意味で、
.ClearContentsメソッドではなく、.Clearメソッドを用いる方が、
却って効率的なケースはあると思います。
　# 仮にですけれど、.Clearに代るメソッドに、引数を指定して、
　　条件付き書式以外のすべてをクリアできる、
　　なんて、新しい機能を誰か作ってくれたなら、もっと簡単なのでしょうけれども。
一応、そういう想定（事情は色々あるでしょう、という意味）で、
私はオーダー通りにお応えしていますので。

まぁでも、上に挙げた「イベントの発行を抑止」の件などもそうですが、
> ＶＢＡでクリア処理しています
そちらのマクロの記述がどんな感じか、気にはなります。
とは言え実物を見ずにはアドバイスするのも難しいですから、
こちらからは手出し出来ないことが多いんですよね。
詰まる所、その人に合ったスタイルで、
自分で管理できる内容で、仕様が満たされていて、問題なく動くなら、
それが正解でいいと私は思いますので。

お礼

cj_moverさん、ありがとうございます。
思っている通りに色を付けることが出来ました。
知識不足、勉強不足を実感致しました。

＞理解に自信持てなさそうな関数、メソッド、プロパティなどがもしあれば、
＞VBE画面上で、各キーワードにカーソルを当てて、F1 キーを押すなどして、
＞ＶＢＡのヘルプの内容程度は、浚っておいてください。
はい。しっかり確認して勉強致します。
.Clearメソッドでクリアしていたので条件付き書式がクリアされていました。
.ClearContentsに変更するとクリアされませんでした。

＞一応、そういう想定（事情は色々あるでしょう、という意味）で、
＞私はオーダー通りにお応えしていますので。
はい。条件付き書式は使用しない方向で進めたいと考えていました。

＞詰まる所、その人に合ったスタイルで、
＞自分で管理できる内容で、仕様が満たされていて、問題なく動くなら、
＞それが正解でいいと私は思いますので。
あたたかいお言葉と丁寧な解説に感謝しています。
もっと勉強しようと思いました。

本当に本当にありがとうございました。

回答No.4

tom04

No.3です。

＞ＶＢＡでクリア処理していますので、条件付き書式もクリアされてしまうのです。
とありますが、

＞セル範囲.Clear　にしていませんか？

＞セル範囲..ClearContents
にすれば書式は消えないと思います。

そして余計なお世話かもしれませんが、No.2さんの補足を読ませていただいて・・・
VBAでA列・I列に色を付ける方法です。
（黄色にしています）

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A,I:I")) Is Nothing Or Target.Count <> 1 Then Exit Sub
With Target
If .Column = 1 Then
.Interior.ColorIndex = xlNone
If LenB(StrConv(.Value, vbFromUnicode)) > 38 Then
.Interior.ColorIndex = 6 '←黄色
End If
Else
.Interior.ColorIndex = xlNone
If LenB(StrConv(.Value, vbFromUnicode)) > 24 Then
.Interior.ColorIndex = 6
End If
End If
End With
End Sub

※　シートモジュールです。m(_ _)m

お礼

tom04さんのおっしゃるように
＞セル範囲..ClearContents
で、書式はクリアされてないようになりました。
親切に教えていただきありがとうございました。

回答No.3

tom04

こんばんは！
横からお邪魔します。

＞シート内のデータをクリアすると条件付き書式までクリアされてしまい困っています
とありますが、
条件付き書式を設定している列そのものを削除してしまうというコトでしょうか？
普通クリアとはDeleteキーでデータのみを消去すると思うのですが・・・

データのみ消去の場合は条件付き書式ではダメでしょうか？

A2セルを選択　→　Shift＋Ctrlキーを押しながら下矢印キーを押下
これでA2セル～A列最終行までが選択されますので
この状態で条件付き書式を設定すれば大丈夫だと思います。

範囲指定されたまま　→　条件付き書式　→　新しいルール　→　数式を使用して・・・　→　数式欄に
=LENB(A2)>38
という数式を入れ　→　書式　→　塗りつぶしから好みの色を選択しOK

※　余計なお世話だったらごめんなさいね。m(_ _)m

お礼

アドバイスありがとうございます。

＞条件付き書式を設定している列そのものを削除してしまうというコトでしょうか？
＞普通クリアとはDeleteキーでデータのみを消去すると思うのですが・・・

ＶＢＡでクリア処理していますので、条件付き書式もクリアされてしまうのです。

回答No.2

cj_mover

手順
Excel画面、対象シートがアクティブな状況から、
　対象シート下部のシートタブを右クリック
　→　［コードの表示］をクリック
　表示された［SheetX モジュール］に以下をコピペ。

' ' シートモジュール

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim r As Range
　　If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
　　With Intersect(Target, Range("A:A"))
　　　　.Interior.ColorIndex = xlColorIndexNone
　　　　For Each r In .Cells
　　　　　　If LenB(StrConv(r.Value, vbFromUnicode)) > 38 Then
　　　　　　　　r.Interior.Color = &H6699FF　　'　　色の指定はご自由に
　　　　　　End If
　　　　Next
　　End With
End Sub

因みに、セル値のバイト長をＶＢＡから採るには、
StrConv()関数を使います。
実際にシート上で=LENB(A1)のような数式で確認用の列を作るなどして、
ちゃんと検証した方がいいですよ。

補足

丁寧な説明と回答ありがとうございます。
上記の手順で思っている通りに色が付きました。
ありがとうございます。

最初の質問後に追加がありまして、
Ａ列に入力した文字数のバイト数が38よりも多い場合にセルに色を付けて、
さらに、I列に入力した文字のバイト数が24より多い場合もセルに色を付けたいのです。
色々試してみましたが、上手く出来ません。
よろしければ、ご教授お願い致します。

回答No.1

housyasei-usagi

例えばこんな感じでどうでしょうか？

Sub test()
For r = 2 To 100
If LenB(Cells(r, 1)) > 38 Then
Cells(r, 1).Interior.Color = RGB(255, 0, 255)
Else
Cells(r, 1).Interior.Color = xlNone
End If
Next
End Sub

以下注意
For r = 2 To 100　の100の訳

　ご質問の式から1048576はマクロの実行時間がかかりすぎると思いますので
とりあえず100までにしてあります。適宜見合う数字にして下さいね。

Cells(r, 1).Interior.Color = RGB(255, 0, 255)

　色はＲＧＢで指定すれば自由ですので適当に数字を変えて下さい。

お礼

すみません。
マクロを実行すると色は付きました。
ありがとうございます。

入力後に文字確定し、再度エンターキーで
次にセルにアクティブセルが移動したときに
色を付けることはできますか？

補足

ご丁寧な回答ありがとうございます。
早速試してみましたが、セルに色は付きませんでした。

試した手順は
（１）シート名（sheet1）を右クリックしてコードの表示
（２）左上の　Microsoft excel objects　内のsheet1をクリック
（３）教えていただいたVBAをコピペ

すでに入力中のセルにも、新規入力したセルにも色が付きません。
試した手順はあっていますか？