1. Home » 
2. Excel講座の総目次 » 
3. Excel VBA入門：目次 » 
4. 色付きのセルを数える/合計する

色付きのセルを数える/合計する:Excel VBA入門

• Excelの一般的な関数では塗りつぶしたセルの個数や数値の合計をすることができません。
  ここではユーザー定期関数を作成して塗りつぶしたセルの個数や合計を計算してみたいと思います。

ユーザー定義関数を作成する　　　Topへ

同じ色のセルの数をカウントする　　　Topへ

• [Alt]+[F11]でVBEを開きます。
  標準モジュールに下表のようなコードを入力します。
  ここでは　Colorプロパティを利用していますので、Excel2007以降で利用できます。なお、Excel2003以前ならColorIndexが利用できます。
  • なお、条件付き書式で設定された色については計算されませんのでご了解ください。
  ここのコードは2015年以前に書いていたものと思われますが、2020/9に当サイトの掲示板で最大値や最小値を求めたいとの質問がありました。
  この質問の回答を作成するにあたり、コードや解説を見直しました。(記 2020/9/10)
  • ’Application.Volatile　とコメントアウトしても再計算されるようです。
    なお、セルの色を変更したときは再計算されませんので、[F9]を押して再計算してください。

  Function ColorCount(R1 As Range, C As Range) As Long 　　Dim r As Range 　　Application.Volatile　’ユーザー定義関数を自動再計算関数にします 　　ColorCount = 0　’初期値 　　For Each r In R1 　　　　If r.Interior.Color = C.Interior.Color Then　'セルの色をチェックします 　　　　　　ColorCount = ColorCount + 1　’カウントの計算 　　　　End If 　　Next r End Function

• VBEの画面は下図のようになります。
  
• 作成したユーザー定義関数　ColorCount の引数は
  =ColorCount(カウントするセル範囲,カウントする色のセル位置)
  としています。
• 求めるセルに　=ColorCount(B2:B17,D2) と入力しています。
  カウントする対象のセル範囲が　B2:B17、セルの塗りつぶしの色(条件とする色)のセルを　D2　とした例です。
  A列はB列のセルのColorの値を表示しています。説明用ですので計算には何も影響していません。
  A列のColorの値とC3セルのColorの値が同じところのセルが計算対象となっているのがわかります。

  • ’A列のセルに色の値（Colorの値）を表示するコードです。 Sub Colortest() 　Dim r As Long 　　For r = 2 To 17 　　　Cells(r, 2).Offset(0, -1) = Cells(r, 2).Interior.Color 　　Next r 　　　Cells(2, 4).Offset(0, -1) = Cells(2, 4).Interior.Color End Sub

  • なお、D2セルに計算するセルの色で塗りつぶしていますが、B列のセルの色を指定しても計算できます。
    その場合は、=ColorCount(B2:B17,B3) 　とします。すると、Dセルは不要になります。
  

同じ色のセルの値を合計する

• コードの例
  

  Function ColorSum(R1 As Range, C As Range) 　　Dim r As Range 　　Application.Volatile 　　ColorSum = 0　’初期値 　　For Each r In R1 　　　　If r.Interior.Color = C.Interior.Color Then 　　　　　　ColorSum = ColorSum + r.Value 　　　　End If 　　Next r End Function

• コードの実行例
  作成したユーザー定義関数　ColorSum の引数は
  =ColorSum(合計するセル範囲 ,合計する色のセル)
  としています。
  

同じ色のセルの値の最大値を求める　　　Topへ

• 2020/9/9に掲示板にて最大値/最小値を求める方法の質問がありましたので、追加しました。
• コードの例
  

  Function ColorMax(R1 As Range, C As Range) 　Dim r As Range 　Application.Volatile 　ColorMax = 0　’初期値 　For Each r In R1 　　If r.Interior.Color = C.Interior.Color Then 　　　If ColorMax < r.Value Then ColorMax = r.Value 　　End If 　Next r End Function

• コードの実行例
  作成したユーザー定義関数　ColorMax の引数は
  =ColorMax(最大値を求めるセル範囲 ,最大値を求める色のセル)
  としています。
  

同じ色のセルの値の最小値を求める　　　Topへ

• コードの例
  

  Function ColorMin(R1 As Range, C As Range) 　Dim r As Range 　Application.Volatile 　ColorMin = 10 ^ 9 　For Each r In R1 　　If r.Interior.Color = C.Interior.Color Then 　　　If ColorMin > r.Value Then ColorMin = r.Value 　　End If 　Next r End Function

• コードの実行例
  作成したユーザー定義関数　ColorMin の引数は
  =ColorMin(最小値を求めるセル範囲 ,最小値を求める色のセル)
  としています。
  

スポンサードリンク

PageViewCounter
　
　Since2006/2/27