Excel2007で複数を単体として検索

質問

前にも似たような形で質問しました。今回は、range(A10:C12)に値A～H + ワイルドカードを自分で１つを選び入れて、１つの形にして検索できるタイプにしたいです。

(1)列HIJの3行目から下に向かって既に入ってあるデータを消して

(2)range(A10:C12)に自分が検索したい(ワイルドカードも時には含めた)形で値A～Hのいずれかを各セルに入れてからマクロボタンを押して

(3)range(A10:C12)を単体とし、それを参照して

(4)(列OPQの最後尾には新しいデータが常に追加されます)O列+P列+Q列から検索し、その検索された１つ下のセルを黄色く色を着けて、その値だけをコピーして

(5)列HIJの3行目から下に向かってそれをペイストして表したいです。

誰か教えて下さい。お願いします。

回答No.4

watabe007 · ベストアンサー

参考に
Sub Test5()
　Dim myRang As Range, c As Range, flg As Boolean
　Dim i As Long, j As Long, LastH As Long, LastO As Long

　Range("H3:J" & Cells(Rows.Count, "H").End(xlUp).Row).ClearContents
　LastO = Cells(Rows.Count, "O").End(xlUp).Row
　Range("O3:Q" & LastO).Interior.Color = xlNone
　For i = 3 To Cells(Rows.Count, "O").End(xlUp).Row - 3
　　Set myRang = Cells(i, "O").Resize(3, 3)
　　For Each c In Range("A10:C12")
　　　j = j + 1
　　　If c.Value <> "*" And c.Value <> myRang.Item(j) Then flg = True
　　Next
　　If flg = False Then
　　　flg = False
　　　Cells(i + 3, "O").Resize(, 3).Interior.Color = vbYellow
　　　LastH = Cells(Rows.Count, "H").End(xlUp).Row + 1
　　　If LastH < 3 Then LastH = 3
　　　　Cells(LastH, "H").Resize(, 3).Value = Cells(i + 3, "O").Resize(, 3).Value
　　　End If
　　　flg = False
　　　j = 0
　　Next
End Sub

お礼

ピシャッとできましたー！！！
ありがとうございますwatabe007さん。

今回は意志疎通が上手くいったきがします。私の複雑な考えはまだまだ有りますのでまた御協力お願いいたします。

回答No.3

SI299792

私の考えているものと、データの入り方が違っているのだと思います。
データがどのように入っていて、検索ワードがどのようなものなのか書いてないので、かなり想像で作りました。
できれば、元のワークブックを上げていただければと思います。
YahooBoxは禁止されているみたいで、前に削除されました。

参考URL：

https://www.filesend.to/

お礼

いつもありがとうございますSI299792さん。私はガラケでもう色々と方法が追いやられてるんでちょっと難しいみたいです。
OPQの3列の3行目から(今のところ1000行目まで)下に向かってA～Hのいずれかが各セルに１つずつぎっしり入ってます。
検索ワードはrange(A10:C12)に格子を入れて
|A|B|*|
|*|C|*|
|*|A|A|
や
|*|*|*|
|A|A|B|
|*|A|B|
のような形で検索してこの形の１つ下の３つ並びのデータを抜き出して指定の所に並べるんです。私の知っている限りなんですがワイルドカードは全てに対応なんでしょうね。
SI299792さんのおっしゃい方だと理解してくれてるようなので意志疎通が上手くできてて嬉しくおもいます。
質問や説明って難しいものですね。

回答No.2

SI299792

[A10:C12] の値をキーワードにしてＯ列＋Ｐ列＋Ｑ列を検索、
結果の１つ下を黄色にして、更に、Ｈ～Ｊにコピーする
という風に解釈しました。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Find As Range
　　Dim FEnd As Range
　　Dim Row As Long
'
　　Range("H3:J" & Rows.Count).ClearContents
　　[O:R].Interior.Pattern = xlNone
　　Row = 2
'
　　For Each Find In [A10:C12]
'
　　　　If Find = "" Then
　　　　　　Set Find = Nothing
　　　　Else
　　　　　　Set Find = [O:Q].Find(Find, _
　　　　　　　　LookIn:=xlValues, Lookat:=xlWhole, searchorder:=xlByRows)
　　　　End If
'
　　　　While Not Find Is Nothing
　　　　　　Set Find = Cells(Find.Row + 1, "O")
'
　　　　　　If Find.Offset(1).Interior.Color <> vbYellow Then
'
　　　　　　　　Set FEnd = Cells(Find.Row + 1, "Q")
　　　　　　　　Range(Find, FEnd).Interior.Color = vbYellow
　　　　　　　　Row = Row + 1
　　　　　　　　Range("H" & Row & ":J" & Row) = Range(Find, FEnd).Value
　　　　　　End If
　　　　　　Set FEnd = Range("Q" & Rows.Count)
　　　　　　Set Find = Range(Find, FEnd).FindNext(FEnd)
　　　　Wend
　　Next Find
End Sub

上記解釈が間違っていたら書いて下さい。

お礼

お久しぶりですSI299792さん。ご協力ありがとうございます。SI299792さんが理解してくれた通りなんでやってみたんですが、列OPQにあるデータの2ヵ所だけが黄色付けされて後はポインタが砂時計になり何もならないです。

回答No.1

msMike

》 前にも似たような形で質問しました
その質問のURLは？

お礼

すみません。質問履歴がなくなってしまってます。