エクセルVBAで条件付書式の色を取得

こんにちは。KenKen_SPです。 ＞これでやっと色のインデックスを取得できましたが、こういうやり方 ＞でいいんですね？ そのとおりです。 既に Wendy02 さんのコードで解決となりますし、ご質問の趣旨から少し はずれるかもしれませんので、ためらいがあったのですが、今後同様の、 つまり「今度はセルの背景色」といった場合にも応用できるように、との 意図を込めて #10 の関数化したコードをアップさせていただきました。 また補足として、条件付き書式を設定する際にユーザーが行う可能性が ある操作について、思いつく限り配慮したものになっています。 例えば 条件付き書式の設定では、下限値と上限値を逆さまに設定しても 正常に動作します。また、これらの数値は、セル参照で設定することも 可能です。 これらに対応するために、#10 のコードでは、サブプロシージャの Swap を設けたり、Formula1 や Formula2 プロパティー値がセル参照式であって もエラーとならないように、 f2 = Evaluate(.Formula2) として値で評価する仕組みになっています。

こんにちは。KenKen_SPです。 ＞...Functionってどうやってつかうんでしょうか？ #10の「以下コード」から終わりまでを標準モジュールにコピー＆ペースト します。 あとは、マクロで LEN や MID などと同様に関数としてコードで使うことも できますし、ワークシートでも通常の関数のようにも使えます。 条件付き書式は 3 つの条件を設定することができますが、ユーザー定義関数 GetCndNum は引数で渡したセルの「条件付き書式」の条件を調べ、もし発動 しているなら、その条件番号 1～3 のいづれかを返します。 もし、「条件付き書式」が設定されていなかったり、発動していなければ 0 を返します。 ・コードで使う場合-------------------------------------------------- Dim F as Integer F = GetCndNum(Range("A1")) でセルA1に設定された条件付き書式で、変数 F には発動している条件付き 書式の条件番号が返ります。0 が返ってきたら条件付き書式は発動していま せん。 条件付き書式の発動条件の番号を調べられれば、あとは知りたい内容で関数 を新たに作ることは容易です。 例えば、#10の再掲になりますが Function GetColorIndex(Target As Range) 　　Dim F As Integer 　　F = GetCndNum(Target) 　　If F Then 　　　　GetColorIndex = _ 　　　　Target.FormatConditions(F).Font.ColorIndex'-----(A) 　　Else 　　　　GetColorIndex = 0 '条件付き書式の色だけほしいのであえて 0 　　End If End Function とコードを標準モジュールに書けば、カラーインデックスが取得できます。 セル背景色を取得したければ、(A)の部分を Target.FormatConditions(F).Interior.ColorIndex と書き換えれば OK です。 このように、ユーザー定義関数は通常の LEN や YEAR 関数のようにコード の中で使用することができます。 ・ワークシートで使う場合---------------------------------------------- 標準モジュールにコードを貼り付けるとワークシートでもユーザー定義関数は 使用することが可能です。 1.　A1セルに条件付き書式を設定 2.　B1セルに計算式　=GetCndNum(A1) を入力 以上でA1セルにデータ入力し、それが 1. で設定した条件を満たせば、その条件 番号が得られます。 先述のユーザー定義関数 GetColorIndex も標準モジュールに貼り付けであれば、 C1 セルに計算式 =GetColorIndex(A1) と入力すると、C1 にはカラーインデックス が表示されます。

merlionXX さん、Wendy02 さん、レスありがとうございました。 いやー、#8で放置してくれ、、とか書きましたけど、本当に放置されなくて うれしいです。 何度も挫折しかかりましたが、何とかコードを書いてみました。ロジックは ほとんど Wendy02 さんから教えていただいたとおりです。#9 で既に解決かと 思いますし、蛇足かもしれませんが、結構頑張って書いたので、折角だから アップさせて下さい。 Wendy02さん、さすがでございます(^^) GetCndNum という関数にしてあります。引数に指定されたセルの条件付き書式 が True ならば、その条件番号を返します。 こうすることのメリットは、例えば今回のような色を取得したといった場合、 次のような関数を作成する際に再利用できそうだからです。 Function GetColorIndex(Target As Range) 　　Dim F As Integer 　　F = GetCndNum(Target) 　　If F Then 　　　　GetColorIndex = _ 　　　　Target.FormatConditions(F).Font.ColorIndex'-----(A) 　　Else 　　　　GetColorIndex = 0 '条件付き書式の色だけほしいのであえて 0 　　End If End Function 応用して(A)で読み取るプロパティーを変えると様々な情報が得られます。 '--------------------　以下コード　------------------------------------ '引数で指定したセルにおいて、そこに設定された条件付き書式の '条件を満たすか調べ、該当する最優先の条件番号を返す '条件を満たさばければ0 を返す Function GetCndNum(rngCel As Range) As Integer 　　Dim f0, f1, f2 　　Dim i As Integer 　　Dim flag As Boolean 　　On Error GoTo ErrorHandler 　　GetCndNum = 0 　　If rngCel.FormatConditions.Count = 0 Or _ 　　　 rngCel.Count > 1 Then Exit Function 　　'条件付き書式の条件を満たすか評価 　　flag = False 　　f0 = Evaluate(rngCel.Value) 　　For i = rngCel.FormatConditions.Count To 1 Step -1 　　　　With rngCel.FormatConditions(i) 　　　　　　If .Type = 2 Then 　　　　　　　　'2:xlExpression 「式が」の場合 　　　　　　　　If Evaluate(.Formula1) Then flag = True 　　　　　　Else 　　　　　　　　'1:xlCellValue　「セルが」の場合 　　　　　　　　f1 = Evaluate(.Formula1) 　　　　　　　　Select Case .Operator 　　　　　　　　　　Case xlBetween 　　　　　　　　　　　　f2 = Evaluate(.Formula2) 　　　　　　　　　　　　If f1 > f2 Then Swap f1, f2 　　　　　　　　　　　　If f1 <= f0 And f0 <= f2 Then flag = True 　　　　　　　　　　Case xlEqual 　　　　　　　　　　　　If f1 = f0 Then flag = True 　　　　　　　　　　Case xlGreater 　　　　　　　　　　　　If f1 > f0 Then flag = True 　　　　　　　　　　Case xlGreaterEqual 　　　　　　　　　　　　If f1 >= f0 Then flag = True 　　　　　　　　　　Case xlLess 　　　　　　　　　　　　If f1 < f0 Then flag = True 　　　　　　　　　　Case xlLessEqual 　　　　　　　　　　　　If f1 <= f0 Then flag = True 　　　　　　　　　　Case xlNotBetween 　　　　　　　　　　　　f2 = Evaluate(.Formula2) 　　　　　　　　　　　　If f1 > f2 Then Swap f1, f2 　　　　　　　　　　　　If Not (f1 <= f0 And f0 <= f2) Then flag = True 　　　　　　　　　　Case xlNotEqual 　　　　　　　　　　　　If f1 <> f0 Then flag = True 　　　　　　　　End Select 　　　　　　End If 　　　　End With 　　　　'戻り値セット 　　　　If flag Then 　　　　　　GetCndNum = i 　　　　　　Exit For 　　　　End If 　　Next i 　　Exit Function ErrorHandler: 　　Err.Clear End Function '値の入れ替え Private Sub Swap(ByRef f1, ByRef f2) 　　Dim tmp 　　tmp = f1 　　f1 = f2 　　f2 = tmp End Sub

merlionXXさん、KenKen-SPさん、ちょっと、夕飯の支度の前に、作ってみました。（^^; Private Sub Worksheet_SelectionChange(ByVal Target As Range) 　Dim myColor As Variant 　Dim i As Long, f2 As String 　With Target 　If .Count > 1 Then Exit Sub 　If .FormatConditions.Count = 0 Then Exit Sub 　　For i = .FormatConditions.Count To 1 Step -1 　　　If .FormatConditions(i).Type = 2 Then 　　　　If Evaluate(.FormatConditions(i).Formula1) Then 　　　　　myColor = .FormatConditions(i).Font.ColorIndex 　　　　End If 　　　　Else 　　　　With .FormatConditions(i) 　　　　On Error Resume Next 　　　　f2 = .Formula2 　　　　If Err.Number > 0 Then 　　　　　　f2 = Empty 　　　　　　Err.Clear 　　　　End If 　　　　On Error GoTo 0 　　　　If FormatCndOperand(.Operator, Target.Value, .Formula1, f2) Then 　　　　　myColor = .Font.ColorIndex 　　　　End If 　　　　End With 　　　End If 　　Next 　　If VarType(myColor) = vbLong Then 　　　MsgBox "ColorIndex: " & myColor 　　　Else 　　　MsgBox "自動=条件付で色が変わっていません。" 　　End If 　End With End Sub Private Function FormatCndOperand(ByVal myType As Long, _ 　　　　　　　　　　　　　　　　　ByVal myValue As Variant, _ 　　　　　　　　　　　　　　　　　ByVal myF1 As Variant, _ 　　　　　　　　　　　　　　　　　ByVal myF2 As Variant) As Boolean Dim myOperand As Variant Dim myFormula As String 'Replace関数があるので、Excel2000 以上,その代用は、Application.Substitute If Not (IsEmpty(myValue)) Then 　myOperand = Array("and(v1>= f1, v1 <= f2)", _ 　　　　　　　　　　 "not(and(v1 >= f1,v1 <= f2))", _ 　　　　　　　　　　 "v1 = f1", _ 　　　　　　　　　　 "v1 <> f1", _ 　　　　　　　　　　 "v1>f1", _ 　　　　　　　　　　 "v1 < f1", _ 　　　　　　　　　　 "v1>=f1", _ 　　　　　　　　　　 "v1<=f1") 　　　　　　　　　　 　myFormula = myOperand(myType - 1) 　myFormula = Replace(myFormula, "v1", myValue) 　myFormula = Replace(myFormula, "f1", myF1) 　If myF2 <> vbNullString Then 　　myFormula = Replace(myFormula, "f2", myF2) 　End If 　FormatCndOperand = Evaluate(myFormula) 　Else 　FormatCndOperand = False 　End If End Function なお、パターンとフォントの区別をさせるコードは、大きくなりすぎますから、アドイン型の方がよいかもしれませんが、元の趣旨から離れてしまうような気がますので、ちょっと遠慮したいです。でも、いつも、merlionXXさんのスレッドは、暴走ぎみになりますね。迷惑じゃないかしら？（^^;

＞基準外（答えが赤字で表示される）のセルを誤って選んでも、色が取得 ＞できればエラーロジックで排除できるので是非組み込みたかったのです。 本来のご質問とははずれるかもしれませんが、このような意図であれば、 条件付書式の色で分岐させるのではなく、値で条件分岐をさせた方が良い と思います。 例えば、簡単な例ですが次のような感じです。 IF Target.Value < 101 Then Exit Sub ＞数式でも値でも条件付書式のフォントの色をちゃんと取得できました。 うーーん。 当方は Windows98SE + Excel2002 の環境なのですが、エラー、、というか 誤まったカラーインデックスが返ります。 ひょっとして、私のやり方がマズイですか? A1：条件付書式の設定 「セルが」「次の値と等しいとき」「5」 とし、A1 に 5 と入力すると 設定した文字色になり、ColorIndex：46　 と表示され、これは正しいのですが、A1 に 1 と入力しても ColorIndex：46 と表示されてしまうのです。 原因としては、「セルが」の場合、 Evaluate(.FormatConditions(i).Formula1) は A1セル の入力値に関わら ず 5 を返しますので、 If 5 Then ～ となるので評価は必ず True （または必ず False) となってしまう。 ですから、「セルが」の場合は、 IF Target.Value = .FormatConditions(i).Formula1 Then のようにセルの値と比較する必要があると思います。 ここで、#6でコメントしたように、Operator プロパティーで指定された 比較方法で条件分岐させる必要性を感じました。 例えば、Operator プロパティーの値が xlBetween であったなら、少なく とも Formula1 と　Formula2 の2つのプロパティーを読みとらないと評価 できないですよね。 うーーん、、、 ※質問者さまを差し置いて悩んでしまい、誠に申し訳ありません。 　ご迷惑なら、放置してください。

KenKen_SPさんへ ＞「数式が」に設定されているときには有効ですが、「セルが」の時 ＞にはエラーになりますね。 「セルが」にする場合は、本日中には無理だと思いますが、少し考えてみます。

＞条件付書式が「発動」したかどうかの判定も無理なのでしょうか？ #1-2 で不可能と書きましたが、、、いやいや、頭から決め付けるのは 良くないですね。不正確な情報で申し訳ありません。 Wendy02 さんが示されたコードのように FormatConditions から条件を 取得して、それを満たしているか調べれば不可能ではなさそうです。 ただ、 If Evaluate(.FormatConditions(i).Formula1) Then ～ は「数式が」に設定されているときには有効ですが、「セルが」の時 にはエラーになりますね。 そこで Wendy02 さんのコードを参考にして私もコードを書いてみたの ですが、どうもうまくいきません。 条件を満たすか判定するには Type プロパティー で 　・セルの値が 　・数式が のいずれかを取得し、それを Operator プロパティーの設定された次の 7 パターンのいづれかで判定しなければならないと思います。 　・xlBetween 　・xlEqual 　・xlGreater 　・xlGreaterEqual 　・xlLess 　・xlLessEqual 　・xlNotBetween 　・xlNotEqual さらに、条件付書式は3つ設定できる、、、 コードを書いてて泣きが入りました(＠＠?)すみません。 今さらこんなこと言うのもなんなのですが、条件付書式で色が変更された かどうが取得したとして、何に使うのでしょうか?

merlionXXさんも、もうそろそろVBAを教える側に入るかもね。 今回のは、あまり高度とは言えないのですが、もし、今回のポイントはどこか、というなら、ここです。 ○　If Evaluate(.FormatConditions(i).Formula1) Then ここに気が付くなら、merlionXXさんは、もう、特に人に聞かなくても、本からでも、VBA掲示板を読んでいるだけでも吸収できると思います。 これは、Range オブジェクトの中に、条件付書式という部分は、FormatConditions というオブジェクト名に収まっています。FormatConditions 「s」がつくのは、いわゆる、コレクションです。コレクションの中に、式が入っていたら、その条件が成立するかどうかをみてあげます。 そのために、Evaluate があるのですが、独特の関数だと思います。ワークシートのあらゆる数式を、VBA上で実現させてしまうものです。WorksheetFunction では、限られてしまいます。 If VarType(myColor) = vbLong Then 次に、私自身、不安が残ったのですが、ある本で、ちょっと読んだことがあったのです。それは、私たちのPCは、32 bit ですから、数値の扱いは、そのままだとLong型になるそうです。null とお書きになっていたので、万が一にも、nullが入っても可能なように、myColor の変数を Variant 型に替えました。 Variant の変数に、数値が入れば、Long型にキャストされてしまう性質を使いました。つまり、何も入らないと、Empty になっていますから、Long型にはなりませんね。 後は、条件付書式って、条件1 > 条件2 >条件3 の順序になっていたと思います。仮に、条件3 で True が成立しても、その上の段階で、True になれば、その上の段階のIndexColor を優先させる、という考え方です。 何か変なところ、疑問がありましたから、ご面倒でもご指摘ください。

二箇所間違えました。（^^; 最初に、Font のカラーを読み落とし、次に、条件付書式の条件の最初にTrueになったものを優先するのを忘れていました。 ？If VarType(myColor) = vbLong Then これは、これでよかったか、ちょっと自信がないので、うまくいかなかったら、ブレークポイントを取って、ちょっと変数の型をみてくださいね。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) 　Dim myColor As Variant 　Dim i As Long 　With Target 　If .Count > 1 Then Exit Sub 　If .FormatConditions.Count = 0 Then Exit Sub 　　For i = .FormatConditions.Count To 1 Step -1 　　　If Evaluate(.FormatConditions(i).Formula1) Then 　　　　myColor = .FormatConditions(i).Font.ColorIndex 　　　End If 　　Next 　　If VarType(myColor) = vbLong Then 　　　MsgBox "ColorIndex: " & myColor 　　　Else 　　　MsgBox "自動=条件付で色が変わっていません。" 　　End If 　End With End Sub

merlionXXさん、こんにちは。（お久しぶりかな？） 即席で作ったので、細かな部分は検討されていないので恐縮ですが、こういうことかな？ Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim fc As FormatCondition Dim myColor As Long 　If Target.Count > 1 Then Exit Sub 　If Target.FormatConditions.Count = 0 Then Exit Sub 　For Each fc In Target.FormatConditions 　　If Evaluate(fc.Formula1) Then 　　　myColor = fc.Interior.ColorIndex 　　End If 　Next 　If myColor > 0 Then 　　MsgBox "ColorIndex: " & myColor 　Else 　　MsgBox "自動=条件付で色が変わっていません。" 　End If End Sub