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

Question

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

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

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

keithin · Accepted Answer

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

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

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

tom04 · Answer

こんばんは！

＞黒のみ入力した数値を抽出し平均をだしたいのですが
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

keithin · Answer

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

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)
と記入する

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

tom04 · Answer

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

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

こんばんは！

ＡＬＴ＋Ｆ１１を押す

No.1です！

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

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング