[[20150630155906]] 『色つきセルのカウント』(あき) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『色つきセルのカウント』(あき)

お世話になります。

教えて頂きたい事が有りトピを立たせて頂きました。
セルの背景に色を付けて管理しているのですが上司から各セルの色の数を
細かく教えろと言われたのですがVBAでカウントするのは可能でしょうか?
また下記のRGB順にカウントして個数を表示させて頂けると助かります。
宜しくお願い致します。

 RGB(30, 30, 30)
 RGB(80, 80, 80)
 RGB(130, 130, 130)
 RGB(200, 200, 200)
 RGB(255, 0, 255)
 RGB(200, 0, 200)
 RGB(155, 0, 155)
 RGB(0, 200, 255)
 RGB(0, 100, 255)
 RGB(0, 0, 255)
 RGB(150, 255, 150)
 RGB(150, 255, 0)
 RGB(0, 255, 0)
 RGB(255, 255, 150)
 RGB(255, 255, 75)
 RGB(255, 255, 0)
 RGB(255, 150, 0)
 RGB(255, 75, 0)
 RGB(255, 0, 0)

< 使用 Excel:Excel2007、使用 OS:Windows7 >


 「検索結果」というシートを追加、標準モジュールに下記を入力し、検索したい範囲を選択してマクロを実行してみてくれ。

 Sub Color_Cnt()
    Dim R_Tbl               As Variant
    Dim G_Tbl               As Variant
    Dim B_Tbl               As Variant
    Dim RGB_Cnt(0 To 18)    As Integer
    Dim Chk_Range           As Range
    Dim Loop_Cnt            As Integer
    Dim Out_Range           As Range

    R_Tbl = Array(30, 80, 130, 200, 255, 200, 155, 0, 0, 0, 150, 150, 0, 255, 255, 255, 255, 255, 255)
    G_Tbl = Array(30, 80, 130, 200, 0, 0, 0, 200, 100, 0, 255, 255, 255, 255, 255, 255, 150, 75, 0)
    B_Tbl = Array(30, 80, 130, 200, 255, 200, 155, 255, 255, 255, 150, 0, 0, 150, 75, 0, 0, 0, 0)

    For Each Chk_Range In Selection
        For Loop_Cnt = 0 To 18
            If Chk_Range.Interior.Color = RGB(R_Tbl(Loop_Cnt), G_Tbl(Loop_Cnt), B_Tbl(Loop_Cnt)) Then
                RGB_Cnt(Loop_Cnt) = RGB_Cnt(Loop_Cnt) + 1
                Exit For
            End If
        Next
    Next
    Set Out_Range = Worksheets("検索結果").Range("A1")
    For Loop_Cnt = 0 To 18
        Out_Range.Value = "RGB(" & R_Tbl(Loop_Cnt) & "," & G_Tbl(Loop_Cnt) & "," & B_Tbl(Loop_Cnt) & ")"
        Out_Range.Offset(0, 1).Value = RGB_Cnt(Loop_Cnt)
        Set Out_Range = Out_Range.Offset(1, 0)
    Next
 End Sub

(ねむねむ) 2015/06/30(火) 16:32


ねむねむ様
ありがとうございます。

初心者の私にとっては魔法ですね! 回答者の方々の知識には頭が下がります。
vbaも少しずつ勉強はしていますが配列で検索は思いもよりませんでした。
早速、明日から仕事で使わせて頂きます。
本当にありがとうございました。
(あき) 2015/06/30(火) 17:39


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.