Excelの文字色でカウントし平均を求める関数

質問

いつもお世話になっております。

今回は、エクセルで使用文字色黒と赤のうち、
黒のみ入力した数値を抽出し平均をだしたいのですが
どのようにして関数またはVBAを組んだらよいでしょうか。

よろしくお願いいたします。

回答No.4

keithin · ベストアンサー

＞空欄のセルも選択しつつ計算から所外

public function averageblack(byval target as excel.range) as double
　dim h as range
　dim res as double, N as long
　application.volatile
　for each h in target
　　if h <> "" and isnumeric(h) and h.font.color = rgb(0,0,0) then
　　　res = res + h.value
　　　n = n + 1
　　end if
　next
　averageblack = res / n
end function

使い方は同じですが，文字色「黒」と「自動」のどちらでもよくしました。
ただし条件付き書式はダメです。

お礼

回答ありがとうございます！！
keithin さんの方法で無事解決できました！
感謝いたします。

回答No.3

tom04

No.1です！

＞ちなみに・・・黒文字も赤文字も表示のまま
＞かつ、空白のセルは自動除外をして計算してくれる方法

当方の思い込みかもしれませんが、前回のA列の「赤文字」に関しては
条件付き書式が設定してあるのでは？

Excel2003までのバージョンだと条件付き書式での色識別は難しいと思います。
（VBAのコードにその条件を入れてやる必要があります）

ただ、Excel2007以降のバージョンだと前回同様「色フィルタ」が利用できますので、
一例です。
Sheet2を作業用のSheetとしていますので、Sheet2は使用していないという前提です。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample2()
Dim i As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")

Application.ScreenUpdating = False
wS1.Range("A1").AutoFilter field:=1, Operator:=xlFilterAutomaticFontColor
wS1.Range("A:B").Copy wS2.Range("A1")
wS2.AutoFilterMode = False
For i = wS2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountBlank(Range(wS2.Cells(i, "A"), wS2.Cells(i, "B"))) > 0 Then
Rows(i).Delete
End If
Next i
wS1.Range("D1") = WorksheetFunction.Average(wS2.Range("B:B"))
wS2.Cells.Clear
wS1.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

今回はD1セルに表示するようにしています。

※　データのレイアウトは前回アップした配置だとします。
※　A列は条件付き書式が設定してあり、「黒」のフォントは「自動」になっている。
※　最初に書いたようにExcel2007以降のバージョンで何とか動くと思います。m(_ _)m

お礼

回答ありがとうございます。
赤文字は、条件付き書式ではありませんが、なんとか解決できました！！

回答No.2

keithin

ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

public function averageblack(byval target as excel.range) as double
　dim h as range
　dim res as double, N as long
　application.volatile
　for each h in target
　　if isnumeric(h) and h.font.colorindex = xlautomatic then
　　　res = res + h.value
　　　n = n + 1
　　end if
　next
　averageblack = res / n
end function

ファイルメニューから終了してエクセルに戻る

テキトーなセル範囲、仮にＡ１：Ａ１０に赤文字や黒文字の数字を記入する
平均値を表示したいセルに
=averageblack(A1:A10)
と記入する

＃注意
１．「黒文字」は文字色「黒」ではなく、文字の色「自動」とします
２．マクロを使うすべての方法の制約として、「文字の色を塗り替えた」直後に自動で計算結果に反映する方法はありません。
　今回の関数の方法では色を塗り替えた後に、Ｆ９キーを押すとか、どこかのセルに何かを記入するなどして再計算を明示的に走り直させる必要があります。
３．言わずもがなですが、例えば与えたセル範囲に一つも数字が記入されていないなど、計算ができない場合はエラーを表示します。

お礼

回答ありがとうございます。
ちなみに、空欄のセルも選択しつつ計算から所外して
くれる方法はありませんか？

図々しくてすみません

回答No.1

tom04

こんばんは！

＞黒のみ入力した数値を抽出し平均をだしたいのですが
Excel2007以降のバージョンをお使いであれば「色フィルタ」で
何とか対応できると思います。

元データのレイアウトが判らないので勝手に↓のような感じでやってみました。
A列のフォント色は「自動」または「赤」のみとします。

D1セル（オートフィルタをかけても非表示にならないセル）に
=SUBTOTAL(1,B:B)
という数式を入れておきます。
オートフィルタ　→　A列でフィルタ　→　色フィルタ　→　「自動」を選択しOK
これで画像のような感じになります。

※　Excel2003までのバージョンの場合は「色フィルタ」は使えませんので
VBAになってしまいます。

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

Sub Sample1() 'この行から
Dim i As Long, cnt As Long, vL
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1).Font.ColorIndex <> 3 Then
cnt = cnt + 1
vL = vL + Cells(i, 2)
End If
Next i
MsgBox vL / cnt
End Sub 'この行まで

※　マクロの場合は抽出はしていません。m(_ _)m

お礼

回答ありがとうございます。
表はtom04さんが作成した状態に似てます。
ちなみに・・・黒文字も赤文字も表示のまま
かつ、空白のセルは自動除外をして計算してくれる方法
っていうのは難しいですか？

注文が多くてすみません。