Findで複数条件の検索をする時について質問です。
現在下記のようなマクロがあります。
C3セルに検索したい文字などを入力した時
C11からC1000までのセルに当てはまるものがあればそのセルを
赤で塗りつぶします。
今回行いたいのは、これに追加してD3セルに入力された内容を
D11からD1000の中で検索、また
E3セルに入力された内容を
E11からE1000の中で検索し
C3、D3、E3に入力されている文字と同じであれば
C3と照らし合わせているC11からC1000の当てはまったセルを赤く塗りつぶしたいです。
C3セルだけや、D3とE3を合ってるけどC3が当てはまっていない場合など
どこかひとつでも当てはまっていなければ塗りつぶしはいりません。
また現在のマクロだとC3に文字が入力された時にマクロが実行されますが
C3、D3、E3の3つ全てのセルに入力されたらマクロが実行されるようにしてもらいたいです。
D3とE3はデータ入力規則のリストでセルに入力を行います。
Private Sub SubProc1(ByVal Target As Range)
Dim c As Range
On Error Resume Next
Set xCur = Selection
If Application.Intersect(Target, Range("C3")) Is Nothing Then Exit Sub
If Range("C3") = "" Then Range("C11:C1000").Interior.ColorIndex = 0: Exit Sub
Application.ScreenUpdating = False
'転記元のブックを開いて逆順で検索する
Set c = Range("C11:C1000").Find(what:=Range("C3").Value, lookat:=xlPart, searchdirection:=xlPrevious, _
MatchCase:=True, MatchByte:=True, SearchFormat:=True)
'見つけた（一番下の）セルを基準に転記する
If Not c Is Nothing Then
c.Interior.ColorIndex = 3
Application.Goto Reference:=c.Offset(0, -1), Scroll:=True
End If
End Sub
えーと・・
お望みの処理を「マクロを使わず」にあえて手作業で行う場合、
あなたならどうしますか？
「複数条件で検索」しか思いつかず、答えに近づけないなら、
おそらく、ＶＢＡ以前に基本機能の復習をオススメします。
「検索」機能は複数の条件を受け付けないので、
お望みの処理には不向きです。
思いつく方法は、例えば
（１）全行に対し、Ｃ・Ｄ・Ｅ列を３行目と照らし合わせ、
全部合致していたら塗りつぶす。
（２）Ｃ列で検索をかけ、当たった行のＤ・Ｅ列を照らし合わせ、
合致していたら塗りつぶす。
（３）Ｃ・Ｄ・Ｅ列をキーにフィルタをかけ、
抽出されたものを塗りつぶし、フィルタを解除する。
他にもありますが、おそらくこのどれか、でしょう。
「普通」という言葉を押し付けるのは好みではないのですが、
複数の条件で対象を絞り込みたいなら、普通はフィルタ機能、
つまり（３）を選択するような気がします。
ちなみにフィルタは
With 対象範囲
.AutoFilter
.AutoFilter Field:=1, Criteria1:=抽出条件１
.AutoFilter Field:=2, Criteria2:=抽出条件２
・
・
End With
こんな感じで使えます。
ま、「マクロの記録」してみればわかりやすいですね。
> C3、D3、E3の3つ全てのセルに入力されたらマクロが実行
Worksheet_Changeイベントに、指定してやれば良いですね。
理解しやすいやり方を挙げるとすると
If Application.CountA(Range("C3:E3")) = 3 Then
～処理～
End If
でしょうか。
そんなわけで、今日は大サービスな私なら
Private Sub Worksheet_Change(ByVal Target As Range)
' 入力したセルが３行目で、Ｃ～Ｅがすべて埋まっていたら実行
If Target.Row = 3 And Application.CountA(Range("C3:E3")) = 3 Then
Application.ScreenUpdating = False
' 既にフィルタがかかっていたら解除
Set MF = ActiveSheet.AutoFilter
If Not MF Is Nothing Then Range("C10").AutoFilter
' Ｃ列のデータがある範囲の最終行を調べる
MR = Cells(Rows.Count, 3).End(xlUp).Row
' Ｃ列の塗りつぶしを一度解除
Columns("C:C").Interior.Pattern = xlNone
' Ｃ～Ｅ列にフィルタ処理、それぞれ３行目を基にフィルタ
With Range("C10:E" & MR)
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Range("C3")
.AutoFilter Field:=2, Criteria1:=Range("D3")
.AutoFilter Field:=3, Criteria1:=Range("E3")
End With
' 抽出された行のＣ列に塗りつぶし（赤）
With Range(Range("C11"), Range("C11").End(xlDown)).Interior
.Pattern = xlSolid
.ColorIndex = 3
End With
' フィルタを解除
Range("C10").AutoFilter
End If
Application.ScreenUpdating = True
End Sub
くらいかなぁ、と思いますよ。
パソコンと表のサイズに依りますが１０００行程度なら一瞬ですよ。
