VBAで特定の色がついたセルがある場合に処理をする。

Question

VBAで書きたいです。

特定の範囲(出来れば図のような範囲、難しい場合はシート全体からでもOK)に
オレンジがあればB1セルに[A]、オレンジがない場合はB1セルに[B]と記載したい場合
どの様にコードを書いたらいいでしょうか。

こんな感じかな、と書いてみたのですが、見当違いなようで動きません。

どなたかアドバイスお願いします。

Sub Test()
    
    Dim Flag
    
	Select Case True
		Case Range("I8:T17").Interior.ColorIndex = RGB(0、166、93)　　　　　'緑
		Case Range("I8:T17").Interior.ColorIndex = RGB(237、28、36)　　     '赤
		Case Range("I8:T17").Interior.ColorIndex = RGB(255, 255, 255)　　   '白　　
		Case Else
			Flag = False
	End Select
	
	If Flag = False Then
		Range("B2") = "〇"
	Else
		Range("B2") = "×"
	End If
		

End Sub

Comments

[sazi]

その色って条件付き書式で設定した色だったりしませんか？

Answer 1

Sub Macro2()
    Dim c As Range

    Application.FindFormat.Interior.Color = 49407
    Set c = ActiveSheet.UsedRange.Find(What:="", SearchFormat:=True)
    Range("B1").Value = IIf(c Is Nothing, "B", "A")
End Sub

まず、
ColorIndexはカラーパレットの番号を示します。
直接色とは関係ありません。（何番のパレットには何色って決まってますが）
手動の場合は、パレットに乗ってる色を選択すると思いますが、
色で表すなら、Colorプロパティの値を参照してください。
それから、 RGB関数は結局整数の数値を返します。
なので、色は、マクロの記録をしてみて得られる数値を、
そのまま流用したほうがいいと思います。
微妙に数字がずれただけで判定が狂います。

次に、シート上の使っている範囲は
ActiveSheet.UsedRangeみたいに表現できます。
そして、
「もし、その中にオレンジに塗りつぶされたセルがあれば、」
というのは、検索機能で色がついたセルも検索できるので、
それで検索してHitすれば「有」と判定できると思うので、
Application.FindFormat.Interior.Color = 49407
Set c = ActiveSheet.UsedRange.Find(What:="", SearchFormat:=True)
と、検索すればいいと思います。
この辺は手動で動作を確認し、マクロの記録でどのようなコードで
書けばいいかを探ってみるといいと思います。
で、見つからなかったら変数の中身がNothingになったままなので、
その状態で、AとBを書き分けます。

Answer 2

やりたいのはこんな感じ？

    Select Case ActiveSheet.Cells(1, 1).Interior.Color
        Case RGB(0, 255, 0)
            MsgBox "緑"
        Case RGB(255, 0, 0)
            MsgBox "赤"
        Case RGB(255, 255, 255)
            MsgBox "白"
        Case Else
            MsgBox "その他"
    End Select

でも、Rangeで複数範囲選択にすると取れない気が。
あとColorIndexとColorを比較してるのがマズイかと。

Answer 3

試してませんが、おそらくこんな感じになるかと思います。
RGBの引数は判定したいオレンジの値に変更してください。

Sub Test()

    Dim Flag As Boolean
    Dim r As Range

	Flag = False
	For Each r In Range("I8:T17")
        If r.Interior.Color = RGB(0, 0, 0) Then
			Flag = True
			Exit For
		End If
	Next

    If Flag = True Then
        Range("B1") = "A"
    Else
        Range("B1") = "B"
    End If

End Sub