Excel。VBA。範囲内の別々の色で塗りつぶされているセルの件数を知りたい
＜Excel VBA＞
範囲選択内で別々の色で塗りつぶされているセル。
それぞれいくつあるのかを、数えたいわけですが、Excelには、塗りつぶされているセルを数える関数はありません。
オートフィルターを使う方法で件数を求めることはできますが、色の数が増えれば増えるほど、大変です。
そこで、今回は、Excel VBAをつかって、範囲選択内の塗りつぶした色ごとに何件あるのかを求めるプログラム文をつくってみました。
Sub 三色を数える()
Dim kinmuhani As Range
Dim yasumi As Range
Dim SampleCell As Range
Dim Cell As Range
Dim i As Integer
Dim OutputCell As Range
Set kinmuhani = Range("B2:D5")
Set yasumi = Range("A7:A9")
Set OutputCell = Range("B7")
For Each SampleCell In yasumi
i = 0
For Each Cell In kinmuhani
If Cell.Interior.Color = SampleCell.Interior.Color Then
i = i + 1
End If
Next Cell
OutputCell.Value = i
Set OutputCell = OutputCell.Offset(1, 0)
Next SampleCell
End Sub
まずは、実行してみましょう。
赤が2で、他の色が1と求めることができました。
では、プログラム文を説明します。
変数宣言以降です。
Set kinmuhani = Range("B2:D5") B2:D5の色を数えいたので、B2:D5を代入しています。
Set yasumi = Range("A7:A9") 数えたい色のサンプルが入力されている範囲のA7:A9を代入します。
Set OutputCell = Range("B7") 最初の色の件数を表示するセルを代入しています。
For Each文をつかった繰り返し処理です。
1色ではないので、For Each文の中に、For Each文が設定されています。
各基準セルについてループ処理
For Each SampleCell In yasumi A7:A9のサンプルが終わるまで繰り返し処理
i = 0 色の件数の変数を初期化します。
For Each Cell In kinmuhani
サンプルの塗りつぶした色を同じだったら、カウントさせます。
If Cell.Interior.Color = SampleCell.Interior.Color Then
i = i + 1
End If
Next Cell
OutputCell.Value = i カウントした結果を代入
Set OutputCell = OutputCell.Offset(1, 0)
結果を表示させる、2件目から次の行にしたいので、Offsetを使用しています。
Next SampleCell
このような方法で、塗りつぶしている色ごとの件数を求めることができます。
