色による識別でのカウントはどうやれば・・？

質問

ｅｘｃｅｌ2007で作成した約70列5000行の表があります。
赤、青、黒など色別の○で区分してあり、各行の赤○、青○、黒○の数を調べ.るために、
COUNTIFでの検索条件を例えば「赤○」と指定したいのですがうまく行きません。
単純なマチガイだと思うのですが・・・数時間やってみてもわかりません。
知人は2007だと色での検索は可能なハズだけど2003しか使っていないので不明とのことです。
直接のカウントが無理なら、赤○はAとかに変換する関数はありますか。

回答No.2

tom04 · ベストアンサー

No.1です！
たびたびごめんなさい。
前回は勘違いしていました。
各行ごとに赤・青・黒（自動）の「○」の個数を表示したい訳ですよね？

もう一度コードを載せておきます。
↓の画像のようにデータは2行目からあり、列方向は1列目～70列目まであるとします。
71～73列目の1行目をフォントの色に塗りつぶしておきます。
そうした上でのコードになります。

Sub test() 'この行から
Dim i, j, k As Long
Dim vl As Variant
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For k = 71 To 73 '←データが70列目までとしています。
For j = 1 To 70 '←データは70列目まで！
If Cells(i, j) = "○" Then
If Cells(i, j).Font.Color = Cells(1, k).Interior.Color Then
vl = vl + 1
End If
End If
Next j
Cells(i, k) = vl
vl = 0
Next k
Next i
End Sub 'この行まで

前回の方法で操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面にコピー＆ペーストしてマクロを実行してみてください。

何度も失礼しました。m(__)m

お礼

単純に関数ではムリなようですね。
ご提示いただいた内容の意味はサッパリ？ですが、コピペで使わせていただきます。
後日、学習時にはまたよろしくお願いいたします。
ありがとうございました。

回答No.1

tom04

こんばんは！
手元にExcel2007がないので、Excel2003での方法の一例です。

Excel2003では色を識別してセルの個数の拾い出しができませんのでVBAでの方法になります。
一例です。
Sheet1の色がついているフォントの種類すべてをSheet2のA列に表示（色）させ、B列のそのセル数を表示するようにしてみました。

画面左下にある操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので、
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i As Long
Dim c As Range
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1") '←Sheet名は適宜変更してください
Set ws2 = Worksheets("sheet2") '←こちらのSheet名も適宜変更
For Each c In ws1.UsedRange
If c = "○" Then
With ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Value = c.Font.ColorIndex
.Interior.ColorIndex = c.Font.ColorIndex
.Font.ColorIndex = c.Font.ColorIndex
End With
End If
Next c
For i = ws2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(ws2.Columns(1), ws2.Cells(i, 1)) > 1 Then
ws2.Rows(i).Delete
End If
Next i
Dim vl As Long
For i = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
For Each c In ws1.UsedRange
If c = "○" Then
If c.Font.ColorIndex = ws2.Cells(i, 1).Interior.ColorIndex Then
vl = vl + 1
End If
End If
Next c
ws2.Cells(i, 2) = vl
vl = 0
Next i
End Sub 'この行まで

尚、Sheet1のフォントの色が自動の場合は「-4105」と表示されるかもしれません。

こんな感じではどうでしょうか？m(__)m