Excel2007で背景にカラーが付いたセルの個数

質問

Excel2007で背景にカラーが付いたセルの個数の合計をあらわしたいです。

セルAA6から下に向かってセルAA4363以上に下に向かってデータが入ってます。データは下に向かって増えていきます。
そのデータの中に色の入ったデータが幾つかあります。一色だけです。

その色の入ったデータの個数の合計をセルAA4に表したいです。

条件付き書式ルールの管理には
数式:=And(AA6=$N7,$N7〈〉"")

適用先=$AA$6:$AE$4363
と設定しています。

お願い致します。

回答No.8

kkkkkm · ベストアンサー

No7は冗長だったので(以前のコードをコピペして修正したので冗長に…)こちらに。
前のElseIfの行が駄目っぽかったので今回は分けてみました。

なお、条件付き書式でしか色を付けないのなら
Else
If .Cells(i, j).Interior.Pattern <> xlNone Then
MyCount = MyCount + 1
End If
は不要です。

Sub Example()
Dim LastRow As Long
Dim i As Long, j As Long, MyCount As Long

With Sheets("Sheet1")
For j = Range("AA:AA").Column To Range("AM:AM").Column
MyCount = 0
If j = Range("AF:AF").Column Then
j = Range("AK:AK").Column
End If
LastRow = .Cells(Rows.Count, j).End(xlUp).Row
For i = 6 To LastRow
If .Cells(i, j).Value = .Cells(i + 1, "N") And .Cells(i + 1, "N") <> "" Then
MyCount = MyCount + 1
Else
If .Cells(i, j).Interior.Pattern <> xlNone Then
MyCount = MyCount + 1
End If
End If
Next i
.Cells(4, j).Value = MyCount
Next j
End With
End Sub

お礼

ありがとうございます。できました。やはりそれぞれのシートの為にソースを用意する形が望ましいでしょうか？
今回のこのマクロは、関数の形とかでは出来ない物に等しかったのでしょうか？
私の説明不足から様々な解答を頂いたので(私は素人でこれはちょっとしたことだと思ってましたが)いつも綺麗な正解をしてくださる方の場合でも戸惑ってることが想像できました。
何か悪い気がしました。
でも助かりました。

回答No.11

kkkkkm

関数はないでしょう。
このような方法でカウントできます。
http://office-qa.com/Excel/ex250.htm

あちらこちらに服を脱ぎ散らかすように質問を散らかさないで、過去の質問は締め切りましょう。最初の問題が解決したら締め切って、新たな疑問があれば新しく質問しましょう、節度がありませんよ。

回答No.10

kkkkkm

> SUMPRODUCT((AA$6:AA$4363=$N$7:$N4364)*($N$7:$N$4364<>""))
は上手くいきましたが、AA4364をAA4364以上は空白であるAA5000にしたところ、動きはしましたが正解は得られませんでした。

それぞれの範囲の行の数を合わなくてはいけません。

((AA$6:AA$4363=$N$7:$N4364)*($N$7:$N$4364<>""))
↓
((AA$6:AA$5000=$N$7:$N5001)*($N$7:$N$5001<>""))

AA6とN7を比較　かつ　N7が空白か?
AA7とN8を比較　かつ　N8が空白か?
：
AA5000とN5001を比較　かつ　N5001が空白か?
というように演算していますので、両方の行数が合わないと計算ができない行が出てくるのでエラーになります。

お礼

kkkkkmさん。ありがとうございます。書式設定されていない形でセルC6からC4364まではデータが入っててそれ以降はセルC5000迄は入ってないという場合のカラーセルカウントは関数での形はどうなりますかね？

回答No.9

kkkkkm

> やはりそれぞれのシートの為にソースを用意する形が望ましいでしょうか？

複数のシートで同じコードを実行したいということでしょうか？
シートの指定が変わりますので、その場合現在見ているシートを参照して実行するというコードに変更しなくてはいけません。

> 関数の形とかでは出来ない物に等しかったのでしょうか

watabe007さんに対しての質問で
bunjiiさんの回答した関数
(bunjii さんは一行ずれているのを見逃してしまったのだと思います。多分うまくいかないと返信すれば手直ししてくれたと思いますよ)
をずれた状態で書き直すと
=SUMPRODUCT((AA$6:AA$4363=$N$7:$N4364)*($N$7:$N$4364<>""))
これで表示できます。AM列まで右にコピーするとすべての列で表示されます。
bunjii さんも言ってますが
条件付き書式でセルの塗りつぶしをしている場合のセルだけが対象になります。
書式の設定で自分で色付けしたものはカウントしません。

watabe007さんに対しての質問にもなんかマクロという言葉が見えましたし、自分で色付けしたものがあればということと、関数はbunjiiさんが回答しているので私はマクロにしました。

お礼

本当にありがとうございます。
もし関数の形で空白が入った場合はどの様な形になりますか？データがきっちりと入ってる場合の

=SUMPRODUCT((AA$6:AA$4363=$N$7:$N4364)*($N$7:$N$4364<>""))
は上手くいきましたが、AA4364をAA4364以上は空白であるAA5000にしたところ、動きはしましたが正解は得られませんでした。
何か良い関数はございませんか？

回答No.7

kkkkkm

> 後、AA列、AB列、AC列、AD列、AE列、AK列、AL列、AM列にも使えるようにするには

以下のような感じで
(チップはいらないですよ。使い道がわからないので…)

Sub Example()
Dim LastRow As Long
Dim i As Long, j As Long, MyCount As Long

With Sheets("Sheet1")
For j = 0 To Range("AM:AM").Column - Range("AA:AA").Column
MyCount = 0
If j = Range("AF:AF").Column - Range("AA:AA").Column Then
j = Range("AK:AK").Column - Range("AA:AA").Column
End If
LastRow = .Cells(Rows.Count, Range("AA:AA").Column + j).End(xlUp).Row
For i = 6 To LastRow
If .Cells(i, Range("AA:AA").Column + j).Value = .Cells(i + 1, "N") And .Cells(i + 1, "N") <> "" Then
MyCount = MyCount + 1
Else
If .Cells(i, Range("AA:AA").Column + j).Interior.Pattern <> xlNone Then
MyCount = MyCount + 1
End If
End If
Next i
.Cells(4, Range("AA:AA").Column + j).Value = MyCount
Next j
End With
End Sub

お礼

ありがとうございました。

回答No.6

kkkkkm

> ElseIf .Cells(i, "AA").Interior.Pattern <> xlNone Then
> が
> デバッグ前に引っ掛かるんです。

というのは、実行時のエラーではなくて
コードをコピペしたときに赤文字になってエラーが出る
ということでしょうか。こちらではエラーが出ないのですが…。
そちらのもの全てをこちらにコピペしていただけますか。
エラーの内容も教えてください。

お礼

ありがとうございました(・∀・)ノ

補足

さっきの追加の質問なんですが各列ごとの4行目に表せれば嬉しいです。私も貴方や皆さんの様なExcel頭脳が欲しいです。うらやましい(^_^)

回答No.5

kkkkkm

No4は色付きセルと条件付きが重なった場合ダブルでカウントされるので訂正
こちらで

Sub Example()
Dim LastRow As Long
Dim i As Long, MyCount As Long

MyCount = 0
With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "AA").End(xlUp).Row
For i = 6 To LastRow
If .Cells(i, "AA").Value = .Cells(i + 1, "N") And .Cells(i + 1, "N") <> "" Then
MyCount = MyCount + 1
ElseIf .Cells(i, "AA").Interior.Pattern <> xlNone Then
MyCount = MyCount + 1
End If
Next i
Range("AA4").Value = MyCount
End With
End Sub

お礼

こんにちは、kkkkkmさん。ご協力ありがとうございます。 すみませんがこのコード(と、言えば良いのか不確かなんですが)
ElseIf .Cells(i, "AA").Interior.Pattern <> xlNone Then
が
デバッグ前に引っ掛かるんです。

回答No.4

kkkkkm

締め切りにでも追われているような質問攻めをしていますが
以下のような感じでしょうか。

AA4363以上にデータが入った場合条件付き書式が範囲外になりそうですが、とりあえずAA列のデータ最終行(数式含む)までを対象にしてます。
Sheet1は適宜変更してください。

'背景色(網掛け含む)有りと条件付き書式が適用されたセルを含めてカウント
Sub Example()
Dim LastRow As Long
Dim i As Long, MyCount As Long

MyCount = 0
With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "AA").End(xlUp).Row
For i = 6 To LastRow
If .Cells(i, "AA").Value = .Cells(i + 1, "N") And .Cells(i + 1, "N") <> "" Then
MyCount = MyCount + 1
End If
If .Cells(i, "AA").Interior.Pattern <> xlNone Then
MyCount = MyCount + 1
End If
Next i
Range("AA4").Value = MyCount
End With
End Sub

お礼

このソースで上手くいきました。ありがとうございます。

ちなみにシートの指定を無しにして、めくるシートの先々にも使用したいです。

後、AA列、AB列、AC列、AD列、AE列、AK列、AL列、AM列にも使えるようにするには
どの様にできますか？

補足

チップは送れる許容限度が過ぎたのでまとめて贈りたいと思います。

回答No.3

msMike

Excel 2013 で検証しました。マクロなんて組む必要なし！

AA4: =SUBTOTAL(3,AA6:AA4363)

範囲 AA6:AA4363 に空白セルがない場合は、超簡単！
セル AA5 に[オートフィルタ]を設定して、当該セルのナビスコマークをクリック ⇒ [色フィルター]のナビスコマークをクリック ⇒ 該当色をツン

以上を理解すれば、途中に空白セルがあってもできることが分かるでせう？

ただ、ソンダケぇ～！

お礼

ありがとうございました。(・∀・)ノ

回答No.2

SI299792

ユーザー定義関数の方が使い勝手がいいと思います。
このマクロを入れて、
AA6 に =InteriorCount(AA6:AA443)
'
Option Explicit
'
Function InteriorCount(ByVal Target As Range) As Integer
'
　　For Each Target In Target
　　　　InteriorCount = InteriorCount - (Target.Interior.Pattern <> xlNone)
　　Next Target
End Function

条件付き書式を使っている場合、ユーザー定義関数ではできません。以下のマクロ使ってください。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Cell As Range
　　Dim Count As Integer
'
　　Count = 0
'
　　For Each Cell In [AA6:AA443]
　　　　Count = Count - (Cell.DisplayFormat.Interior.Pattern <> xlNone)
　　Next Cell
　　[AA4] = Count
End Sub

同じ質問をしていますね。
ここはwatabe007 専用の様なのでなので開けておきます。

参考URL：

https://okwave.jp/qa/q9606201.html

お礼

すみません。ご返答暖かくかんじます。
ありがとうございました。

回答No.1

unokwave

標準関数ではできないので、マクロを組むかそのような関数を持つaddinをWindowsにインストールして利用するしかありません。

そのような関数を持つaddinとその使い方は
http://www.excel.studio-kazu.jp/DL/UFClr/index.html

お礼

ご返答ありがとうございました。色々な方法があるもんなんですね。