VBA 条件付書式の条件にあっているか

質問

条件付書式の数式に該当したセルの内容のみ拾ってくるVBAの作成を
試みています。
アンケート用紙は以下のようになっています。
A1　男性　　　　　B1　年齢
A2 /////////
A3
A4　///////

A1の性別B1の年齢から判断して条件付書式下記のよう式が入っています。
　（A2　　=COUNTIF($A$1,"女*")>=1
　　A3　　=COUNTIF($A$1,"男*")>=1
　　A4　　=COUNTIF($A$1,"*男*")>+COUNTIF($B$1,"2*"）>=1　　）

ただその際にA2/A4は網掛けになっているのですが場合によって前回の
回答を消去せずにアンケート表が作成されていることがあり、網掛け部分の
数値も拾ってきてしまい集計表が正しくなくなってしまいます。

集計表に情報を取ってくる際に、条件付書式がTrueの場合、または書式
が白抜きになっている場合で条件分岐したいので教えてください。
方法としては下記のようになるかと考えています。
・セルに条件付書式がひとつ以上設定されている。（今回は条件は一つです）
・その条件が、値か式か。（今回は式です）
・式であったら、その式をVBA上で実行してTrueかFalseか判断する
　（または書式のタイプを取得する）
ですが、書ける知識が乏しくて・・・

よろしくお願いします。

回答No.6

_Kyle · ベストアンサー

#3,5です。

結局、最初の変換のxlRelativeが余計なだけだったようです　^^;;
このパターンは最初に試したんですが
別のポイントで詰まって泥沼にハマっていました。

以下、修正版です。

●FCcheck1(【対象セル】,【対象条件】)

【対象セル】の【対象条件】番目の真偽に応じて、TRUE/FALSEを返す

'=====↓　ココカラ　↓================================================
Function FCcheck1(ByVal myCel As Range, ByVal myIdx As Long) As Boolean
　Dim myFml As String
　With myCel.FormatConditions
　　If .Count < myIdx Then Exit Function
　　If .Item(myIdx).Type <> xlExpression Then Exit Function
　　myFml = .Item(myIdx).Formula1
　　myFml = Application.ConvertFormula(myFml, xlA1, xlR1C1)
　　myFml = Application.ConvertFormula(myFml, xlR1C1, xlA1, xlAbsolute, myCel)
　　FCcheck1 = Evaluate(myFml)
　End With
End Function
'=====↑　ココマデ　↑================================================

●FCcheck2(【対象セル】,【対象条件】)

【対象セル】の【対象条件】番目の真偽に応じて、セルの値を返す

'=====↓　ココカラ　↓================================================
Function FCcheck2(ByVal myCel As Range, ByVal myIdx As Long) As Variant
　Dim myFml As String
　FCcheck2 = ""
　With myCel.FormatConditions
　　If .Count < myIdx Then Exit Function
　　If .Item(myIdx).Type <> xlExpression Then Exit Function
　　myFml = .Item(myIdx).Formula1
　　myFml = Application.ConvertFormula(myFml, xlA1, xlR1C1)
　　myFml = Application.ConvertFormula(myFml, xlR1C1, xlA1, xlAbsolute, myCel)
　　If Evaluate(myFml) Then FCcheck2 = myCel.Value
　End With
End Function
'=====↑　ココマデ　↑================================================

以上ご参考まで。

お礼

ありがとうございます。

会社のPCで参考にしながら書いたらうまくいきました！
手元に資料がないのですが、
・対象セルの条件付書式をカウントして０だったら　GoToｘｘ
・条件付書式がセルに対象されていたら　Evaluateで条件付書式の式の
True/Falseを判定
・Trueだったら対象セルをアンケート集計用紙Workbookにコピーする

というようなかんじです。

私が集計表つくります！といったもののどうせ出来ないんでしょ、と思われて
たみたいで、出来上がってほっとしました。
ありがとうございました。

回答No.5

_Kyle

#3です。

>どのあたりがまずいのかわからなくて

Formula1で取れる数式をそのままEvaluateに投げた場合、
数式が絶対参照のみで書かれていれば正しい結果が得られますが、
数式に相対参照が含まれていると正しい結果が得られません。

例えば、A2セルの条件式が、
　=COUNTIF($A$1,"女*")>=1
であればうまくいくけれども、
　=COUNTIF(A1,"女*")>=1
だとうまくいかないということです。

#3の回答は、その点に配慮したつもりだったのですが
逆に、相対参照⇒○　絶対参照⇒×
ということになっただけでした(^^;;

>条件付書式は絶対参照で書かれているのです

ということなので、
#4様のご回答で課題は解決するかと思います。
私はもう少し考えてみるつもりですが
締切っていただいても構いません。

お礼

なるほど説明ありがとうございました。

会社のPCでみなさんの回答を参考にVBを書いたら
うまくいきました！

締め切りってあるんですか？このQ&A？？？

いろいろわからないことだらけ・・・

ほんとありがとうございました。

回答No.4

mt2008

No.2です。
質問をよく読んだら、条件式の「式」がTRUEかどうかだけを判断してTRUEが１つでもあればそのセルの値を返す……で、良いんですね？
「値」まで考えると長ったらしくなりますが、式の場合だけならこんな感じです。

Function fSample(Target As Range) As Variant
　fSample = ""
　If Target.FormatConditions.Count = 0 Then Exit Function
　For i = 1 To Target.FormatConditions.Count
　　With Target.FormatConditions(i)
　　　'条件が式の場合
　　　If .Type = xlExpression Then
　　　　If Evaluate(.Formula1) Then
　　　　　fSample = Target.Value
　　　　　Exit Function
　　　　End If
　　　End If
　　End With
　Next i
End Function

お礼

mt2008さん、ありがとうございます！

そうなんです、やりたかったのは書いていただいたとおりです。
（説明が上手でなくてスミマセン）

一つ前の回答していただいた方も　Evaluateを使ってましたが
これが知りたかったのでーーーーす。
本で調べても載っていなくて、どうやってVB上で式を実行するの？
と思って悶々と悩んでいました。

これで明日会社のPCで実行してみます。
ほんとありがとうございました。

回答No.3

_Kyle

こういったことでしょうか？

関数にしてみました。

●動作の概要

　FCchk(【対象セル】,【対象条件】)　
　とすると
　【対象セル】に設定されている条件付き書式について
　【対象条件】番目の条件をチェックし
　結果が真であればTRUEを、偽であればFALSEを返す。

　【対象条件】番目の条件が設定されていない場合はFALSEを返す。
　【対象条件】番目の条件が数式でない場合もFALSEを返す。

●運用例…というか動作テスト

'-----↓　タトエバ　↓------------------------------------------------
Sub test()
　Dim myCel As Range
　For Each myCel In Range("A2:A4")
　　MsgBox FCchk(myCel, 1)
　Next myCel
End Sub
'-----↑　コンナカンジデ　↑------------------------------------------

●ここから本コード

'=====↓　ココカラ　↓================================================
Function FCchk(ByVal myCel As Range, ByVal myIdx As Long) As Boolean

　Dim myFml As String

　With myCel.FormatConditions

　　 '条件が設定されていない場合はFalseを返して抜ける
　　If .Count < myIdx Then
　　　FCchk = False: Exit Function
　　End If

　　 '条件が数式でない場合もFalseを返して抜ける
　　If .Item(myIdx).Type <> xlExpression Then
　　　FCchk = False: Exit Function
　　End If

　　'条件式を取得して計算
　　myFml = .Item(myIdx).Formula1
　　myFml = Application.ConvertFormula(myFml, xlA1, xlR1C1, xlRelative)
　　myFml = Application.ConvertFormula(myFml, xlR1C1, xlA1, xlAbsolute, myCel)
　　FCchk = Evaluate(myFml)

　End With

End Function
'=====↑　ココマデ　↑================================================

※条件式に相対参照が含まれている場合、
　Formula1を取得した時点では、アクティブセルを基点にした参照になっています。
　そこで、いったんR1C1形式に変換してから、
　対象セルを基点とするA1形式の数式に再変換しています。

Excel2003で動作確認。以上ご参考まで。

お礼

いろいろありがとうございます。
条件付書式は絶対参照で書かれているのです。。。

知識の乏しい私にはどのあたりがまずいのかわからなくて、、、
明日会社のPCで研究してみます。

回答No.2

mt2008

条件付書式の条件もセルも判っているのですから、そのまま条件を使って値を取ったらいかがですか？

Sub Sample()
　Dim test

　test = ""
　If Application.WorksheetFunction.CountIf(Range("A1"), "男*") >= 1 Then
　　test = Range("A3")
　End If

　MsgBox ("A3:" & test)
End Sub

お礼

ありがとうございます。

例ではセルが３つですが、実際のアンケート表は条件付書式が入力
されているセルが２０あるのです。
で一括で表現できないかと思ったのですが、方法が見つからなかったら
この方法でやってみます。

回答No.1

n-jun

前回不思議に思ったのですが、どのセルのデータが必要なのでしょうか？
⇒Ａ２～Ａ４で且つ条件がある？
　あるいはＡ３のみでいい？

データと必要な条件と求めたい結果を提示された方がいいかもしれません。
⇒もしかすると私の勘違いかも知れませんが。

補足

前回不思議に思ったのですが、どのセルのデータが必要なのでしょうか？
⇒Ａ２～Ａ４で且つ条件がある？
　あるいはＡ３のみでいい？

上のケースですとA３のみです。　（＝a3のみが条件付書式にあっている）

データと必要な条件と求めたい結果を提示された方がいいかもしれません。
⇒もしかすると私の勘違いかも知れませんが。

A1　男性　B1　25歳
A2　////////
A3 　チョコレート (A3が必要なデータ）
A4　//////////　

A1　女性　B1　32歳
A2　タバコ (A2が必要なデータ）
A3　///チョコレート/// (条件付書式にあっていないが前回データが残っている
　　　　　　　　　　　　　　　このデータは必要なし。セルは網掛け）
A4 //////////

この補足でわかりますでしょうか？