[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『色付けしたセルのカウントができる関数』（困ってます、ああ）
教えてください。
Excelで関数を使って色付きセルのカウントをしたいです。
E5～E20 までを（A～Cさん）で氏名毎でカウントしていました。
カウントイフで数えていたのですが
ここに色付け（黄色）をしたセルの数を引きたいです。
可能でしょうか？
調べても行き詰ってしまいました。
皆様のお力をお貸しいただけたら幸いです。
よろしくお願いいたします。
＜ 使用 Excel：unknown、使用 OS：Windows11 ＞
色（セルの塗りつぶし色ですか?）を判定できるワークシート関数は提供されていません。 ユーザー定義関数を使うことになります。
最初に確認ですが、黄色は、どのような基準でつけていますか？ 他の情報で客観的に決まるものなら、ワークシート関数で判定できますね。 それが曖昧なもので、客観的に再現できず、色を出発点とせざるを得ないものなら、 ユーザー定義関数(UDF）を使うことになります。
まずは、ここまで確認したい。色をつける基準について説明ください。 また、Excelのバージョンを明記してください。
（xyz） 2023/06/16(金) 16:19:57
Excelのバージョンは確認方法から見た所
Microsoft Office Home and Business 2019
とありました。こちらで大丈夫でしょうか？
また色付けは曖昧で利用が終了した方に色付けをしていました。
この場合は、色が出発点となるのでしょうか？
知識不足で申し訳ありませんが、ご教授いただければ幸いです。
（困ってます、ああ） 2023/06/16(金) 16:58:05
(1)
まず、セルの塗りつぶし色が黄色ならTrue、そうでないならFalseを返すUDFを作ります。
標準モジュールに下記をコピーして下さい。
Function isYellow(rng As Range) As Boolean
Application.Volatile
isYellow = rng.Interior.Color = vbYellow
End Function
(2) F5 セルに =isYellow(E5) と入れると、 E5セルが黄色ならTrue, そうでなければFalseを返します。 それを以下にコピーします。
(3) あとは、COUNTIFSを使って、 ・E列がAであり、 ・F列がFalseのものだけの個数を集計すれば、 黄色ではないセルに絞った、Aさんの個数合計が計算できます。 他の方も同じです。こんなことでどうでしょうか。
(4) なお、色を変えるだけでは、isYellowは再計算しません。 シートのどこかのセルを変更すれば、再計算します。 （逆に言うと、それだけ余計な再計算をする、とも言えます） この点を理解しておいてください。
あとは、氏名のカウントもユーザー定義関数でもできますが、 一番簡単なものに限っておいたほうが、逆に汎用的に使えるかと思いました。 その他の手法は別の方からのコメントを期待してください。それでは。
（xyz） 2023/06/16(金) 17:17:01
参考にやってみます。
貴重なお時間をいただきましてありがとうございます。
（困ってます、ああ） 2023/06/16(金) 17:41:08
同じ人でも色をつける場合とつけない場合があるってこと？
どっちにしても、そういうことは色だけで区別するのではなく どこかの列にフラグを立てた方がいいのでは？
たとえば F列だとして
E F 4 名前 区分 5 C 1 6 A 7 B 1 8 B 9 A 10 C 11
終了の場合は F列に「1」を入力 ※E列に色をつけたいのなら条件付き書式で（数式：=F5=1）
氏名ごとのカウントは
H I 5 A 2 6 B 1 7 C 1
I5 =COUNTIFS($E$5:$E$20,H5,$F$5:$F$20,"") 下コピー
参考まで （笑） 2023/06/16(金) 18:00:08
参考にしてください。 違っていたらスルーしてください。 >利用が終了した方に色付けをしていました。 どこかの列に終了と記載されているとしています。 終了のところだけ色付けされているとしています。
>ここに色付け（黄色）をしたセルの数を引きたいです。 COUNTIF($A$2:$A$21,D$2)で同じ氏名をカウントする。 COUNTIFS($A$2:$A$21,$D2,$B$2:$B$21,"終了")で同じ氏名の「終了」をカウントする。 色なし「色付け（黄色）をしたセルの数を引きたいです。」 E2=COUNTIF($A$2:$A$21,D$2)-COUNTIFS($A$2:$A$21,$D2,$B$2:$B$21,"終了") 下へコピー
|[A] |[B] |[C]|[D] |[E]
[1] |名前 |区分| |名前 |色なし
[2] |たなか |終了| |たなか | 2
[3] |さとう |終了| |さとう | 3
[4] |すずき | | |すずき | 3
[5] |いけだ |終了| |いけだ | 2
[6] |たなか | | | |
[7] |さとう | | | |
[8] |すずき |終了| | |
[9] |いけだ | | | |
[10]|たなか |終了| | |
[11]|さとう | | | |
[12]|すずき | | | |
[13]|いけだ |終了| | |
[14]|たなか | | | |
[15]|さとう | | | |
[16]|すずき |終了| | |
[17]|いけだ | | | |
[18]|たなか |終了| | |
[19]|さとう |終了| | |
[20]|すずき | | | |
[21]|いけだ |終了| | |
条件付き書式 数式を使用して、=B2="終了" （IT） 2023/06/16(金) 22:40:23
ちょっと脱線しに来ました ^^;
「黄色黄色って、どこまで黄色と認めるんだい?」という 実務ではまず直面することが無いであろう(しょうもない)課題を仮定した場合に、 ひょっとしたら部分的にでも役に立つかもしれないカラーモデル間変換関数どものデモです。 (ホントはクッソ長いユーザーフォーム使った遊び道具なんだけど関数部分だけ抜粋してのお届け)
Option Explicit
Sub test()
[A1:A20].Value = [{60;0.95;0.9;0.85;0.8;0.75;0.7;0.65;0.6;0.55;0.5;0.45;0.4;0.35;0.3;0.25;0.2;0.15;0.1;0.05}]
[B1:K1].Value = [{0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1}]
[A23:A48].Value = [{45;46;47;48;49;50;51;52;53;54;55;56;57;58;59;60;61;62;63;64;65;66;67;68;69;70}]
[L22:T22].Value = [{0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9}]
[A2:A20,B1:K1,L22:T22].NumberFormat = "0%"
[B2:K20].FormulaR1C1 = "=HSL2RGB(R1C1,R1C,RC1)"
[B23:K48].FormulaR1C1 = "=HSL2RGB(RC1,R1C,0.5)"
[B51:T76].FormulaR1C1 = "=ToWebColor(R[-28]C)"
[L2:T20].FormulaR1C1 = "=ToWebColor(RC[-10])"
[L23:T48].FormulaR1C1 = "=HSL2RGB(RC1,1,R22C)"
[B2:T20,B23:T48,B51:T76].Select
PaintThisRGB
[A1].Select
End Sub
Function ThisRGB(Optional ByVal Target As Range) As Variant
With Application
.Volatile
If Target Is Nothing Then Set Target = .ThisCell Else Set Target = Target.Cells(1, 1)
ThisRGB = Target.Interior.Color
If Target.Interior.ColorIndex = xlColorIndexNone Then ThisRGB = CVErr(xlErrNA)
End With
End Function
Sub PaintThisRGB()
Dim R As Range
For Each R In ActiveWindow.RangeSelection.Cells
R.Interior.Color = R.Value
R.Font.Color = IIf(GetYfromRGB(R.Value) > 0.5!, &H0&, &HFFFFFF)
Next
End Sub
Rem =================================================================================================================
Rem カラー値計算関数群
Rem 参考文献
Rem 『CSSの色合成式をVBAで再現』（中途B） エクセル Excel [エクセルの学校]
Rem https://www.excel.studio-kazu.jp/kw/20181219225917.html
Rem PEKO STEP - 無料で楽しめるゲームやアプリの配信サイト
Rem https://www.peko-step.com/
Rem
Rem =================================================================================================================
Function SplitRGB(aRGB As Long, Optional Percentage As Boolean) As Variant
Rem RGB値をR,G,Bの各要素の配列に変換
Dim i As Long, Ary(0 To 2) As Variant
For i = 0 To 2
Ary(i) = (aRGB \ &H100& ^ i) Mod &H100&
If Percentage Then Ary(i) = CSng(Ary(i) / &HFF&)
Next
SplitRGB = Ary
End Function
Function ToWebColor(aRGB As Long) As Long
Rem RGB値を(昔懐かし)Webセーフカラーに丸めて返す
Dim vRGB() As Variant, i As Long
vRGB = SplitRGB(aRGB)
For i = 0 To 2
vRGB(i) = szMRound(CDbl(vRGB(i)), 51#)
Next
ToWebColor = vRGB(0) + vRGB(1) * &H100& + vRGB(2) * &H10000
End Function
Private Function szMRound(Number As Double, Divisor As Double) As Double
Rem なんちゃってMROUND関数
szMRound = Fix(CDec((Number + Divisor / 2) / Divisor)) * Divisor
End Function
Function GetYfromRGB(aRGB As Long) As Single
Rem RGB値から輝度信号Y(0以上1以下の数値)を算出
Const prmR = 0.298912!, prmG = 0.586611!, prmB = 0.114478!
Dim vRGB() As Variant
vRGB = SplitRGB(aRGB)
GetYfromRGB = vRGB(0) * prmR + vRGB(1) * prmG + vRGB(2) * prmB
GetYfromRGB = GetYfromRGB / &HFF&
If GetYfromRGB > 1! Then GetYfromRGB = 1!
If GetYfromRGB < 0! Then GetYfromRGB = 0!
End Function
Function RGB2Gray(aRGB As Long) As Long
Rem グレースケールに変換した時のRGB値を算出
RGB2Gray = GetYfromRGB(aRGB) * &HFF&
RGB2Gray = RGB2Gray + RGB2Gray * &H100& + RGB2Gray * &H10000
End Function
Function GetSfromRGB(aRGB As Long, Optional HSLMode As Boolean) As Single
Rem RGB値から彩度(0以上1以下)を算出(オプションHSLカラーモデル用の計算スイッチ)
Dim vRGB() As Variant, vMax As Long, vMin As Long, i As Long
vRGB = SplitRGB(aRGB)
vMin = vRGB(0): vMax = vRGB(0)
For i = 1 To 2
If vRGB(i) > vMax Then vMax = vRGB(i)
If vRGB(i) < vMin Then vMin = vRGB(i)
Next
If HSLMode Then
If vMax = vMin Then Exit Function
If (vMax + vMin) / 2 < &H80& Then
GetSfromRGB = (vMax - vMin) / (vMax + vMin)
Else
GetSfromRGB = (vMax - vMin) / (&HFF& * 2 - vMax - vMin)
End If
Else
If vMax = 0 Then Exit Function
GetSfromRGB = (vMax - vMin) / vMax
End If
If GetSfromRGB > 1! Then GetSfromRGB = 1!
If GetSfromRGB < 0! Then GetSfromRGB = 0!
End Function
Function GetVfromRGB(aRGB As Long) As Single
Rem RGB値から明度(0以上1以下の数値)を算出
Dim vRGB() As Variant, vMax As Long, i As Long
vRGB = SplitRGB(aRGB)
vMax = vRGB(0)
For i = 1 To 2
If vRGB(i) > vMax Then vMax = vRGB(i)
Next
GetVfromRGB = vMax / &HFF&
If GetVfromRGB > 1! Then GetVfromRGB = 1!
If GetVfromRGB < 0! Then GetVfromRGB = 0!
End Function
Function GetLfromRGB(aRGB As Long) As Single
Rem RGB値からHSLカラーモデル用の輝度(0以上1以下の数値)を算出
Dim vRGB() As Variant, vMax As Long, vMin As Long, i As Long
vRGB = SplitRGB(aRGB)
vMin = vRGB(0): vMax = vRGB(0)
For i = 1 To 2
If vRGB(i) > vMax Then vMax = vRGB(i)
If vRGB(i) < vMin Then vMin = vRGB(i)
Next
GetLfromRGB = (vMax + vMin) / 2 / &HFF&
If GetLfromRGB > 1! Then GetLfromRGB = 1!
If GetLfromRGB < 0! Then GetLfromRGB = 0!
End Function
Function GetHfromRGB(aRGB As Long) As Variant
Rem RGB値から色相(360度)を算出
Rem 例
Rem 赤: RGB = &HFF& => 0/360
Rem 黄: RGB = &HFFFF& => 60/360
Rem 緑: RGB = &HFF00& => 120/360
Rem シアン: RGB = &HFFFF00 => 180/360
Rem 青: RGB = &HFF0000 => 240/360
Rem マゼンタ:RGB = &HFF00FF => 300/360
Dim vRGB() As Variant, vMax As Long, vMin As Long, i As Long, MaxPos As Long
vRGB = SplitRGB(aRGB)
vMin = vRGB(0): vMax = vRGB(0)
For i = 1 To 2
If vRGB(i) > vMax Then
vMax = vRGB(i)
MaxPos = i
End If
If vRGB(i) < vMin Then vMin = vRGB(i)
Next
If vMax = vMin Then
GetHfromRGB = Null '-1!
Exit Function
End If
If MaxPos = 0 Then
GetHfromRGB = CSng(60& * ((vRGB(1) - vRGB(2)) / (vMax - vMin)))
ElseIf MaxPos = 1 Then
GetHfromRGB = CSng(60& * ((vRGB(2) - vRGB(0)) / (vMax - vMin)) + 120&)
ElseIf MaxPos = 2 Then
GetHfromRGB = CSng(60& * ((vRGB(0) - vRGB(1)) / (vMax - vMin)) + 240&)
End If
GetHfromRGB = CSng(GetHfromRGB - 360& * Int(GetHfromRGB / 360&))
End Function
Function GetYfromHSL(h As Single, s As Single, L As Single) As Single
Rem HSLカラーモデルから輝度信号Yを算出(0以上1以下の数値)
Const prmR = 0.298912!, prmG = 0.586611!, prmB = 0.114478!
Dim Yp As Single, a As Single, c As Single
Dim pMax As Single, pMid As Single
h = h - 360& * Int(h / 360&)
Select Case h
Case Is < 60!
pMax = prmR: pMid = prmG
a = (h Mod 60!) / 60!
Case Is < 120!
pMax = prmG: pMid = prmR
a = 1 - (h Mod 60!) / 60!
Case Is < 180!
pMax = prmG: pMid = prmB
a = (h Mod 60!) / 60!
Case Is < 240!
pMax = prmB: pMid = prmG
a = 1 - (h Mod 60!) / 60!
Case Is < 300!
pMax = prmB: pMid = prmR
a = (h Mod 60!) / 60!
Case Is >= 300!
pMax = prmR: pMid = prmB
a = 1 - (h Mod 60!) / 60!
End Select
Yp = pMax + pMid * a
c = 2 * s * (0.5! - Yp)
If L > 0.5! Then
GetYfromHSL = L * (1 + c) - c
Else
GetYfromHSL = L * (1 - c)
End If
End Function
Function GetLfromHSY(h As Single, s As Single, Y As Single) As Single
Rem HS値と輝度信号YからHSLカラーモデルのL値を算出 (H は360度、SとYは0以上1以下の数値を指定)
Const prmR = 0.298912!, prmG = 0.586611!, prmB = 0.114478!
Dim Yp As Single, a As Single, c As Single
Dim pMax As Single, pMid As Single
h = h - 360& * Int(h / 360&)
Select Case h
Case Is < 60!
pMax = prmR: pMid = prmG
a = (h Mod 60!) / 60!
Case Is < 120!
pMax = prmG: pMid = prmR
a = 1 - (h Mod 60!) / 60!
Case Is < 180!
pMax = prmG: pMid = prmB
a = (h Mod 60!) / 60!
Case Is < 240!
pMax = prmB: pMid = prmG
a = 1 - (h Mod 60!) / 60!
Case Is < 300!
pMax = prmB: pMid = prmR
a = (h Mod 60!) / 60!
Case Is >= 300!
pMax = prmR: pMid = prmB
a = 1 - (h Mod 60!) / 60!
End Select
Yp = pMax + pMid * a
c = 2 * s * (0.5! - Yp)
If Y > (1 - c) / 2! Then
GetLfromHSY = (Y + c) / (1 + c)
Else
GetLfromHSY = Y / (1 - c)
End If
End Function
Function HSV2RGB(ByVal h As Single, s As Single, v As Single) As Long
Rem HSV値からRGB値を算出 (H は360度、SとVは0以上1以下の数値を指定)
Dim vMax As Long, vMin As Long, vRGB(0 To 2) As Long
vMax = v * &HFF&
vMin = vMax - s * vMax
h = h - 360& * Int(h / 360&)
Select Case h
Case Is <= 60!
vRGB(0) = vMax
vRGB(1) = (h / 60!) * (vMax - vMin) + vMin
vRGB(2) = vMin
Case Is <= 120!
vRGB(0) = ((120! - h) / 60!) * (vMax - vMin) + vMin
vRGB(1) = vMax
vRGB(2) = vMin
Case Is <= 180!
vRGB(0) = vMin
vRGB(1) = vMax
vRGB(2) = ((h - 120!) / 60!) * (vMax - vMin) + vMin
Case Is <= 240!
vRGB(0) = vMin
vRGB(1) = ((240! - h) / 60!) * (vMax - vMin) + vMin
vRGB(2) = vMax
Case Is <= 300!
vRGB(0) = ((h - 240!) / 60!) * (vMax - vMin) + vMin
vRGB(1) = vMin
vRGB(2) = vMax
Case Is > 300!
vRGB(0) = vMax
vRGB(1) = vMin
vRGB(2) = ((360! - h) / 60!) * (vMax - vMin) + vMin
End Select
HSV2RGB = vRGB(0) + vRGB(1) * &H100& + vRGB(2) * &H10000
End Function
Function HSL2RGB(ByVal h As Single, s As Single, L As Single) As Long
Rem HSL値からRGB値を算出 (H は360度、SとLは0以上1以下の数値を指定)
Dim vMax As Long, vMin As Long, vRGB(0 To 2) As Long
If L <= 0.5! Then
vMax = &HFF& * (L + L * s)
vMin = &HFF& * (L - L * s)
Else
vMax = &HFF& * (L + (1 - L) * s)
vMin = &HFF& * (L - (1 - L) * s)
End If
h = h - 360! * Int(h / 360!)
Select Case h
Case Is <= 60!
vRGB(0) = vMax
vRGB(1) = (h / 60!) * (vMax - vMin) + vMin
vRGB(2) = vMin
Case Is <= 120!
vRGB(0) = ((120! - h) / 60!) * (vMax - vMin) + vMin
vRGB(1) = vMax
vRGB(2) = vMin
Case Is <= 180!
vRGB(0) = vMin
vRGB(1) = vMax
vRGB(2) = ((h - 120!) / 60!) * (vMax - vMin) + vMin
Case Is <= 240!
vRGB(0) = vMin
vRGB(1) = ((240! - h) / 60!) * (vMax - vMin) + vMin
vRGB(2) = vMax
Case Is <= 300!
vRGB(0) = ((h - 240!) / 60!) * (vMax - vMin) + vMin
vRGB(1) = vMin
vRGB(2) = vMax
Case Is > 300!
vRGB(0) = vMax
vRGB(1) = vMin
vRGB(2) = ((360! - h) / 60!) * (vMax - vMin) + vMin
End Select
HSL2RGB = vRGB(0) + vRGB(1) * &H100& + vRGB(2) * &H10000
End Function
Function HSY2RGB(ByVal h As Single, s As Single, Y As Single) As Long
Rem HS値と輝度信号YからRGB値を算出 (H は360度、SとYは0以上1以下の数値を指定)
HSY2RGB = HSL2RGB(h, s, GetLfromHSY(h, s, Y))
End Function
Function GetReversal(aRGB As Long) As Long
Rem 反転色を算出
Dim vRGB() As Variant, i As Long
vRGB = SplitRGB(aRGB)
For i = 0 To 2
vRGB(i) = &HFF& - vRGB(i)
Next
GetReversal = vRGB(0) + vRGB(1) * &H100& + vRGB(2) * &H10000
End Function
Function GetComplementary(aRGB As Long) As Long
Rem 補色を算出
Dim vRGB() As Variant, vMax As Long, vMin As Long, i As Long
vRGB = SplitRGB(aRGB)
vMin = vRGB(0): vMax = vRGB(0)
For i = 1 To 2
If vRGB(i) > vMax Then vMax = vRGB(i)
If vRGB(i) < vMin Then vMin = vRGB(i)
Next
For i = 0 To 2
vRGB(i) = (vMax + vMin) - vRGB(i)
Next
GetComplementary = vRGB(0) + vRGB(1) * &H100& + vRGB(2) * &H10000
End Function
Rem =================================================================================================================
（白茶） 2023/06/16(金) 23:13:08
（困ってます、ああ） 2023/06/19(月) 17:31:43
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.