セルに色を塗る｜Excelマクロの記録で覚えるVBA

最終更新日：2013-02-18

第12回.セルに色を塗る

今回はちょっと難しいことをします。

100マス計算に手入力で回答を入れて、その結果の成否を判定してみましょう。

100マスの計算結果を一旦全て消して下さい。

手入力で、回答を入れて下さい。

掛け算九九は大丈夫ですか（笑）

全部入れなくて良いです。

いくつかは、正しい答えを入れ、いくつかは、間違った答えを入れましょう。

えっ、普通に答えても間違えてしまう・・・グッドです。

マクロで、間違いは赤、未回答は黄色にセルを塗ってみましょう。

以下のようにします。

Excel解説

ふふふ、間違え方が自然でしょう、本当に間違えていたりして（笑）

まず、色の塗り方ってどうするのか。

まさに、「マクロの記録」の出番です。

１．マクロの記録

２．D3を選択

３．黄色にする

４．F7を選択

５．赤色にする

６．記録終了

作成されたマクロは、




Sub Macro2()
'
' Macro2 Macro
'
'
　　Range("D3").Select
　　With 
Selection.Interior
　　　　.Pattern = xlSolid
　　　　.PatternColorIndex = 
xlAutomatic
　　　　.Color = 65535
　　　　.TintAndShade = 
0
　　　　.PatternTintAndShade = 0
　　End 
With
　　Range("F7").Select
　　With Selection.Interior
　　　　.Pattern = 
xlSolid
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 
255
　　　　.TintAndShade = 0
　　　　.PatternTintAndShade = 0
　　End 
With
End Sub

なんだか、とっても長いですね。

まず、With～End Withの説明です。

これは、マクロの記録ではよく出てくる記述になります。

With ○○○

　　.△△△

　　.□□□

End With
これは、

○○○.△△△

○○○.□□□

と書いたことと同じになります。

このWithを使うことで、記述を簡潔にし、かつ、処理スピードが速くなります。

先頭の「.」が重要です！

そして、

★★★.Select

With Selection.○○○

・・・

End With
これは、

With ★★★.○○○

・・・

End With

とSelectionを、Selectしている対象に変更すれば良いです。

不要部分を消し込むと、




Sub Macro2()

      
　　With Range("D3").Interior
　　　　.Pattern = 
xlSolid
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 
65535
　　　　.TintAndShade = 0
　　　　.PatternTintAndShade = 0
　　End 
With

　　With Range("F7").Interior
　　　　.Pattern = 
xlSolid
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 
255
　　　　.TintAndShade = 0
　　　　.PatternTintAndShade = 0
　　End 
With
End Sub

まだ、長いですね。

セルに色を塗るのに必要なものは、

.Color = 数字

だけです、他は網掛け等の指定になりますので、今回は不要です。

従って、




Sub Macro2()

      
　　Range("D3").Interior.Color = 65535
　　Range("F7").Interior.Color 
= 255
End Sub

これだけで良いということになります。

とても、すっきりしちゃいましたね。

カラーの数値については、そのまま受け入れましょう。

基本色は、文字定数がありますが、

マクロの記録を使えば、様々な色が使用できますので、そのまま使用すれば良いでしょう。

さて、色の塗り方がわかったところで、本題のプログラムに移ります。




Sub Macro1()
　　Dim i
　　Dim j
　　i = 2
　　Do While i <= 
11
　　　　j = 2
　　　　Do While j <= 11

      　　　　　　If Cells(i, j) = "" 
Then
　　　　　　　　Cells(i, j).Interior.Color = 65535
　　　　　　Else
　　　　　　　　If 
Cells(i, j) <> Cells(i, 1) * Cells(1, j) Then
　　　　　　　　　　Cells(i, 
j).Interior.Color = 255
　　　　　　　　End If
　　　　　　End If

      　　　　　　j = 
j + 1
　　　　Loop
　　　　i = i + 1
　　Loop
End 
Sub