VBAを使い塗り潰す

条件（範囲列A~D）に合う数字を各指定の色で塗りつぶしをしたいのですが、、、。

塗りつぶしの範囲はB3～GN62です。
A2~A12の範囲にある数字と該当する場合は、黄色
B2~B12の範囲にある数字と該当する場合は、オレンジ
C2～C12の範囲にある数字と該当する場合は、黄緑
D2~D12のの範囲にある数字と該当する場合は、紫
列A~Dまでは、歯抜けの状態ですべてのセルに数字が入ってるわけではありません。

知恵者の皆様の御回答をお待ちしております。

No.1 ベストアンサー 回答者： siffon9 回答日時： 2016/02/01 18:16

こんな感じで如何でしょう。

---------------------------
Sub aaa()
Dim r As Range
Dim area As Range
Dim idx As Long
Dim color(4) As Long
color(0) = RGB(&HFF, &HFF, 0) ' 黄色
color(1) = RGB(&HFF, &H99, 0) ' オレンジ
color(2) = RGB(&HAA, &HFF, 0) ' 黄緑
color(3) = RGB(&HAA, 0, &HFF) ' 紫

For Each r In Range("B3:GN62") ' 塗りつぶし範囲
idx = 0
Set area = Range("A2:A12") ' 条件エリアの初期値をセット
Do While (area.Column < 5) ' 条件エリアがD列まで繰り返す
If searchValue(r.Value, area) Then
r.Interior.color = color(idx)
Exit Do
End If
idx = idx + 1
Set area = area.Offset(0, 1) ' 条件エリアを一つ右へ
Loop
Next
End Sub


' area内のnumの値のセルがあればtrue, 無ければfalse
Function searchValue(num As Long, area As Range) As Boolean
Dim r As Range
For Each r In area
If (r.Value <> "") And (num = CLng(r.Value)) Then
searchValue = True
Exit Function
End If
Next
searchValue = False
End Function

この回答へのお礼

ありがとうございました！
助かりました。

お礼日時：2016/02/10 10:35