選択セル範囲内から色がついているセルの数を数えたりする

更新:2009.6.19

目次

エクセルで表を作っていると、たまに「赤いセルだけカウントしたい。」とか「黄色いセルだけカウントしたい。」なんて事を思うときがあると思います。

そこで、選択セル範囲と、色番号を渡してあげると、色がついているセルの数や、割合を返してくれる標準モジュールを以下の様なステップで作ってみました。

  1. 選択セルの色番号を取得する
  2. 選択セル範囲から黄色セルの割合を取得する
  3. 再計算処理を入れる

選択セルの色番号を取得する

まずは、色番号をを調べる必要がありますので、以下の様な関数を作成して、色番号を取得してみます。

' 選択セルの色番号を取得する
' 使い方:getColorNum(セル)
Function getColorNum(cell)
    getColorNum = cell.Interior.ColorIndex
End Function

何かしらの数字が帰ってくると思います。

選択セル範囲から黄色セルの割合を取得する

色番号が取得できたかと思いますので、次に以下の様な関数を作成して、セルの範囲と、色番号を渡してあげましょう。

' 選択セル範囲から黄色セルの割合を取得する
' 使い方:getColorFraction(セル範囲,色番号)
Function getColorFraction(cell_range As Range, color_num As Long)
    Dim c_count As Long
     ' 変更があった場合に再計算させる。
    Application.Volatile
    c_count = 0
    For Each current_cell In cell_range
        If current_cell.Interior.ColorIndex = color_num Then
            c_count = c_count + 1
        End If
    Next current_cell
    getColorFraction = c_count / cell_range.Count
End Function

これで、選択範囲内の指定した色がついているセルがどれくらいの割合で含まれているかを調べることが出来ます。

VBA便利!!

と、思ったら色を変更してもリアルタイムに更新されない!!!

これを解決するためには、次のようにする必要があります。

再計算処理を入れる

以下の様なコードを対象のシートに書いておくと、セレクションチェンジが起こったときに、シートを再計算するようになります。

' SelectionChangeでシート内再計算
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.Worksheets("シート名").Activate
     ' コピペ作業中は再計算しない。
    If Application.CutCopyMode =  Then
        ActiveSheet.Calculate
    End If
End Sub

よし!これで色を変更をしてカーソルが移動した瞬間に、再計算してくれるようになったぞ!!!

と思ったら、、、[F4]キーによる操作の繰り返しが再計算にされてしまうという弊害が、、、

今のところ僕にとって大きな弊害ではないので、様子を見ることにします。

IT関係関連記事

NASの選び方
2017/06/06










これからブログなどのサイトを作りたいと思っている人は、お名前.comでのドメイン取得がオススメです。

■□━━ 急げ、ドメインは早い者勝ち! ━━□■
     ■お名前.com

アマゾンの2019年本屋大賞一覧

そして、バトンは渡された
ひと
ベルリンは晴れているか
熱帯
ある男

楽天市場のおすすめ商品一覧

お金2.0 新しい経済のルールと生き方 [ 佐藤航陽 ]
全部レンチン!やせるおかず 作りおき 時短、手間なし、失敗なし
「読む力」と「地頭力」がいっきに身につく 東大読書 [ 西岡 壱誠 ]