こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

マクロで全体から検索を行うには?

お世話になります。
以下のようなマクロがあります。これは、このマクロのあるEXCELファイルと同じホルダーにある複数のEXCELファイルのそれぞれ1列目が検索内容と一致するときに該当する行を抜き出す(転記する)というものです。

そこで質問なのですが、

(1)1列目だけでなく全ての列から検索を行い、該当する行を抜き出すにはどうしたらよいですか?
(2)完全一致ではなく部分一致にするにはどうしたらよいですか?

Sub Test()
Dim ans, fn, wb, x, i, n, sh, myPath
ans = InputBox("検索ワードを札幌支店のように入力します。")
myPath = ThisWorkbook.Path & "\"
fn = Dir(myPath & "*.xls") '選択したフォルダ内のExcelファイルを検索します
Do Until fn = "" '全て検索し終えると、filename = Empty となるので、その間以下を実行します
If fn <> ThisWorkbook.Name Then 'ファイルが自分以外なら
Set wb = Workbooks.Open(myPath & fn) '選択したファイルを開きます
For Each sh In wb.Worksheets '各シートごとに
x = sh.Cells(Rows.Count, 8).End(xlUp).Row '最終行取得
For i = 1 To x '1行目から最終行まで以下を実行します
If Cells(i, 1) = ans Then '入力と同じなら
n = n + 1
With ThisWorkbook.Sheets("Sheet1") '転記
.Cells(n, 1) = sh.Cells(i, "A")
.Cells(n, 2) = sh.Cells(i, "J")
.Cells(n, 3) = sh.Cells(i, "k")
.Cells(n, 4) = sh.Cells(i, "m")
.Cells(n, 5) = sh.Cells(i, "k")
.Cells(n, 6) = sh.Cells(i, "m")
.Cells(n, 7) = sh.Cells(i, "n")
.Cells(n, 8) = sh.Cells(i, "o")
.Cells(n, 9) = sh.Cells(i, "q")
.Cells(n, 10) = sh.Cells(i, "k")
End With
End If
Next i
Next sh
wb.Close (False) '選択したファイルを閉じる
End If
fn = Dir() '次のファイルを検索
Set wb = Nothing
Loop '繰り返し
End Sub

お手数をおかけしますがよろしくお願い致します。

投稿日時 - 2009-04-08 10:41:47

QNo.4862323

困ってます

質問者が選んだベストアンサー

2の回答は
If Cells(i, 1) = ans Thenを
If Cells(i, 1) Like ("*" & ans & "*") Then
とすれば解決すると思います。

1はどういうケースを想定しているのかがよくわかりません。
__A列 B列
1.札幌xxx 空欄
2.空欄 札幌xxx
3.札幌xxx 札幌xxx

おそらく今は1と3のケースに対応していると思いますが
2のケースを対象としたいのか、
3のケースでは2回転記したいとか1回転記したら次の行に移りたいとか
そのあたりをもう少し詳しく書いてくれればレスがつくと思います

投稿日時 - 2009-04-08 12:49:10

お礼

書込み、ありがとうございます♪
1については2と同時に作用させたかったのですが、同時に作用させると逆に不具合があることもわかったので、これでやってみます^^
助かりました、ありがとうございますm(_ _)m

投稿日時 - 2009-04-08 14:10:22

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問