[[20140819105825]]　『[談] 条件付き書式の着色セル判定ツール』（半平太）　ページの最後に飛ぶ

『[談] 条件付き書式の着色セル判定ツール』（半平太）

 『塗りつぶしたセルのカウント』（和代）
[[20140810090742]] 
 に絡んで条件付き書式対応版のColor関数が公開停止となっってしまったようです。

 Ver2010以降に関しては「DisplayFormat」の登場で希望が涌いたものの、
 ユーザー定義関数では機能しないと判明して、また闇の中に入ってしまいました。

 そこで全バージョンで使える「FmtCondIntrCLRAnyVer」なる関数を考えました。
 ご興味のある人向けにアップします。

 この関数は「数式が」モードで設定した条件で色が付いたセルについて
 そのColorIndexを配列で返すものです。

 この関数さえあれば、後は何とでもなります。
 　別のユーザー定義関数で再利用してもいいですし、
 　ワークシート上で直接利用してもいいです。

 ※正直言って、いろんな要望（SumだとかCountだとか色指定だとか）を
 　一つ一つ作りこむのは煩雑すぎる感があります。
 　似たようなものばかりが出来上がります。（これはやってられない、私は。）

 使用上の注意事項
 １．Ver2007以降ではFormatConditionの「AppliesTo」や「StopIfTrue」プロパティを
 　使いますのでバージョンに合わせて条件付きコンパイルが必要となります。

 　なので、1行目の#Const xlsm12 = 12　の定数にエクセルのバージョンを入れる必要があります。
 　(・・・と云っても、2003以前が11、2007以降が12の決め打ちで構わないです。）

 ２．「数式が」モードでの設定に限りますので、適用範囲に別モードの設定が
 　一つでも入っていると結果が正しくならないので、その場合はすべて
 　"「数式が」以外の設定有り"　のエラーが返ります。

 　従ってこの関数を有効活用するには「数式が」モードだけの設定にする必要があります。

 使用例
 　B2:D5の範囲の全部または一部のセルに「数式が」モードの条件付き書式による着色がある場合
 　結果表示セルに　=FmtCondIntrCLRAnyVer(B2:D5)　と入力
 　ただし配列なので、この関数の単独使用で意味があるのは、
 　範囲が単一セルでその着色番号(ColorIndex)が知りたい時のみ。

 　通常は、個数を数えたり、合計を出すので（赤=3のセルが対象なら）、

 　個数 =SUMPRODUCT(N(FmtCondIntrCLRAnyVer(B2:D5)=3))+TODAY()*0
 　合計 =SUMPRODUCT(N(FmtCondIntrCLRAnyVer(B2:D5)=3),B2:D5)+TODAY()*0

 　※ Today()*0　はApplication.Volatileの代わり

 ’－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
 #Const xlsm12 = 12 '←自分のバージョンにする(xlmsは12以上)
 Const msgXlExpression = "「数式が」以外の設定有り"

 Public Function FmtCondIntrCLRAnyVer(rngToProc As Range)
     Dim rr As Long, cc As Long  'アクティブセルとのオフセット差
     Dim RRR As Long, CCC As Long 'XLSM用オフセット値
     Dim strFmla As String       '修正後条件式
     Dim TrueOrFalse As Variant
     Dim fmtCndton As FormatCondition
     Dim eachCel As Range
     Dim result As Long
     Dim Results() As Variant
     Dim NN As Long, MM As Long
     Dim rngRow As Range

     If ValueOfFCtypeExists(rngToProc) Then　’「数式が」モードのみかチェック
         FmtCondIntrCLRAnyVer = msgXlExpression
         Exit Function
     End If

     ReDim Results(1 To rngToProc.Rows.Count, 1 To rngToProc.Columns.Count) As Variant

     NN = 0
     For Each rngRow In rngToProc.Rows
         NN = NN + 1
         MM = 0
         For Each eachCel In rngRow.Cells
             rr = activecell.Row - eachCel.Row
             cc = activecell.Column - eachCel.Column

             MM = MM + 1
             result = 0

             For Each fmtCndton In eachCel.FormatConditions
                 #If xlsm12 >= 12 Then
                     RRR = activecell.Row - fmtCndton.AppliesTo.Row
                     CCC = activecell.Column - fmtCndton.AppliesTo.Column
                 #End If
                 strFmla = fmtCndton.Formula1

                 With Application
                     strFmla = .ConvertFormula(fmtCndton.Formula1, _
                                     xlA1, xlR1C1, , eachCel.Offset(rr, cc))
                 #If xlsm12 >= 12 Then
                         strFmla = .ConvertFormula(strFmla, _
                                     xlR1C1, xlA1, , eachCel.Offset(RRR, CCC))
                     #Else
                            strFmla = .ConvertFormula(strFmla, xlR1C1, xlA1, , eachCel)
                     #End If
                 End With

                 TrueOrFalse = Evaluate(strFmla) '条件式を評価

                 If Not IsError(TrueOrFalse) Then
                     If TrueOrFalse Then
                         #If xlsm12 >= 12 Then
                             If Not IsNull(fmtCndton.Interior.ColorIndex) Then
                                   result = fmtCndton.Interior.ColorIndex
                                   Exit For
                              ElseIf fmtCndton.StopIfTrue Then '停止条件がTrueならこれ以上追及しない
                                   result = 0
                                   Exit For
                              End If
                         #Else '停止条件不考慮(Trueになったので、いずれにしてもExitForとなる）
                             If Not IsNull(fmtCndton.Interior.ColorIndex) Then
                                   result = fmtCndton.Interior.ColorIndex
                             Else
                                   result = 0
                             End If
                             Exit For
                         #End If
                      End If
                 End If
             Next
             Results(NN, MM) = result
         Next
     Next
     FmtCondIntrCLRAnyVer = Results
 End Function

 Private Function ValueOfFCtypeExists(rngToProc As Range) As Boolean
     Dim aCell As Range
     Dim FC As FormatCondition
     ValueOfFCtypeExists = False
     For Each aCell In rngToProc
 '     If aCell.FormatConditions.Count Then
         For Each FC In aCell.FormatConditions
             If Not FC.Type = xlExpression Then
                 ValueOfFCtypeExists = True
                 Exit Function
             End If
         Next
 '     End If
     Next
 End Function

＜使用アプリ：Mac以外すべて、使用 OS：Windows7 ＞

ありがとうございます。
自己責任にて利用させていただきます。

（ryopo^2） 2014/08/19(火) 12:29

 使ってみました！
 result = fmtCndton.Interior.ColorIndex
 ここの部分自分で工夫すれば、Fontの色などいくらでも応用ききそうですね！

 複数条件（赤と黄色）をカウントしたいときはこんな感じですか？
 =SUMPRODUCT(N(FmtCondIntrCLRAnyVer(A1:A5)={6,3}))

 見ていてよくわからなかったのが「Activecell」はどこのことなんでしょう・・・
 式が入力されているセル・・？

 最後に重箱の隅
 #Const xlsm12 = 12 '←自分のバージョンにする(xlmsは12以上)
                                                ~~

（稲葉） 2014/08/19(火) 12:56

 ＞複数条件（赤と黄色）をカウントしたいときはこんな感じですか？
 ＞=SUMPRODUCT(N(FmtCondIntrCLRAnyVer(A1:A5)={6,3}))

 範囲が縦一列ならそんな使い方になりますね。
 (2次元の範囲だと、2つに分けざるを得ません。まぁ一般的なSumproductの使い方ですけど)

 ＞ 見ていてよくわからなかったのが「Activecell」はどこのことなんでしょう・・・
 ＞ 式が入力されているセル・・？

 ここが不思議なとこなんですけど、それは通常のActiveCellです。
 ActiveCellの位置によってFormula1の数式が勝手に変化するので
 ActiveCellの位置を把握して数式のセルアドレスを補正する必要があるんです。

 ※手操作で条件数式を確認するときは、当該セルをアクティブにするので気が付かないのですけど、
 　マクロだと、アクティブセル以外のセルの条件式が覗けるのですけど、
 　その条件式は、当該セルをアクティブにして見たものとはずれているんです。

 ＞ 最後に重箱の隅
 ＞ #Const xlsm12 = 12 '←自分のバージョンにする(xlmsは12以上)

 ありゃ、済みません。ついでに少し丁寧な表現に訂正します。＾＾

 （拡張子がxlsmであるものは、12以上）

（半平太） 2014/08/19(火) 13:37

コメント返信：

[ 一覧(最新更新順) ]

[[20140819105825]] 『[談] 条件付き書式の着色セル判定ツール』（半平太） ページの最後に飛ぶ

[[20140819105825]]　『[談] 条件付き書式の着色セル判定ツール』（半平太）　ページの最後に飛ぶ