【VBA】クリックする毎にセル色が変わる

Excelのセルをクリックするたびに、「色なし→赤→青→黄→黒→色なし」などのように色を順番に変更する方法があれば教えてください。
下記のSelectionChangeコードで、「色なし→黄→色なし」にできるのですが、複数の色を順番に表示させたいと思っております。
お手数お掛けいたしますが、よろしくお願い致します。

=================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim 各セル As Range
Set Target = Intersect(Target, Range("A1:A5"))

If Target Is Nothing Then Exit Sub

For Each 各セル In Target
With 各セル
If .Value = 1 Then
.ClearContents
.Interior.Pattern = xlPatternNone
Else
.Value = 1
.Font.ColorIndex = 6
.Interior.ColorIndex = 6
End If
End With
Next
End Sub

=================================================

No.1 ベストアンサー 回答者： MackyNo1 回答日時： 2014/03/24 23:36

Select Caseですべての場合に分けてセル色を変更すればよいのではないでしょうか。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim 各セル As Range
Set Target = Intersect(Target, Range("A1:A5"))
If Target Is Nothing Then Exit Sub
For Each 各セル In Target
With 各セル
Select Case .Interior.ColorIndex
Case xlPatternNone
.Interior.ColorIndex = 3
Case 3
.Interior.ColorIndex = 5
Case 5
.Interior.ColorIndex = 6
Case 6
.Interior.ColorIndex = 1
Case 1
.Interior.ColorIndex = xlPatternNone
End Select
End With
Next
End Sub

この回答へのお礼

早々にご回答くださり誠にありがとうございます。
「Select Caseステートメント」を使って条件により処理を分岐させるという方法ですね。大変勉強になりました。

ご教示いただいたVBAで動作確認しましたら、希望通りの結果を得ることができました！
本当にありがとうございました(#^.^#)

お礼日時：2014/03/26 00:58

No.2 回答者： 30246kiku 回答日時： 2014/03/25 08:41

色の順とか個数は

　　iAry = Array(xlPatternNone, 3, 5, 6, 1)
部分を変更するだけです
以下、色の部分だけ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　Dim iAry As Variant
　　Dim r As Range
　　Dim i As Long

　　iAry = Array(xlPatternNone, 3, 5, 6, 1)

　　Set Target = Intersect(Target, Range("A1:A5"))
　　If (Target Is Nothing) Then Exit Sub

　　For Each r In Target
　　　　For i = 0 To UBound(iAry)
　　　　　　If (iAry(i) = r.Interior.ColorIndex) Then Exit For
　　　　Next
　　　　i = i + 1
　　　　If (i > UBound(iAry)) Then i = 0
　　　　r.Interior.ColorIndex = iAry(i)
　　Next
End Sub

この回答へのお礼

早々にご回答くださり誠にありがとうございます。
Array関数を使って値を格納し、「UBound関数」で配列の大きさを調べ、カウントし条件により分岐処理する方法ですね。大変勉強になりました。

ご教示いただいたVBAで動作確認しましたら、希望通りの結果を得ることができました！
本当にありがとうございました(#^.^#)

お礼日時：2014/03/26 01:09