エクセル マクロ 文字列の検索と抽出

質問

エクセル2010を使っています。

画像の様に、【Sheet3】のA列～CQ列に　空白・エラー・数値・文字　の入った表があります。

そのL列には、画像の様な形で様々な地域の名前が入っています。

やりたいのは、L列に　検索対象文字が複数、例えば　福岡　か　大阪　が入っていたら、その表ごと抽出し、【Sheet１】の上から順に枠線ごと貼り付けて行きたいと思います。

この時、両方一致ではなく、検索対象の文字列が一つでも含まれていたら抜き出したいと思います。

その時に　【Sheet3】から抽出した部分は削除し、上に詰めて行きたいと思います。

ちなみに検索対象が、福岡・大阪・名古屋等、増える場合もありますので、増えたとき対応が出来る形が理想です。

ちなみにL列の文字と文字の間は　・　だったり　/　だったりします。

詳しい方、よろしくお願い致します。

回答No.1

tom04 · ベストアンサー

こんばんは！

＞検索対象文字が複数、例えば　福岡　か　大阪　が入っていたら・・・
とは必ず8行の中すべてに「福岡」か「大阪」が入っていたら！というコトでしょうか？
すなわち1行でも参照文字がない場合、その8行の範囲は無視する！という解釈での一例です。

標準モジュールです。

Sub Sample1()
Dim i As Long, k As Long, myCnt As Long, myMax As Long, wS As Worksheet, myAry
Set wS = Worksheets("Sheet1")
myAry = Array("福岡", "大阪") '←ココに増えたデータを追加する★
With Worksheets("Sheet3")
For i = 1 To .Cells(Rows.Count, "L").End(xlUp).Row Step 8
myMax = 0
For k = 0 To UBound(myAry)
myMax = WorksheetFunction.Max(myMax, WorksheetFunction.CountIf(.Cells(i, "L").Resize(8), "*" & myAry(k) & "*"))
Next k
If myMax = 8 Then
Range(.Cells(i, "A"), .Cells(i, "CQ")).Resize(8).Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next i
If WorksheetFunction.CountA(wS.Rows(1)) = 0 Then
wS.Rows(1).Delete
End If
End With
End Sub

こんなんではどうでしょうか？m(_ _)m

お礼

回答ありがとうございます！！

滅茶苦茶良いです。
助かりました、ありがとうございます。