この人頭いいなと思ったエピソード

VBA勉強中です。
フォルダにある複数のファイル(1ファイル内には複数シートあります)を順番に開けて検索をかけ、条件に合致した行をあるファイルへ転記・集約させるマクロを組みたいと思っています。
(条件は1番左の列が「○」であることです。)

ネットや本を参考にしながら組んでみたのですが、「○」がない(シートの)行も転記されてしまい困っています。
(○があるシートは複数シートの内、1シートのみなのですが、○がないシートからも
「○があるシートの○がある行」と同じ行番号の行がが転記されているようです)

組んでみたマクロは以下のとおりです。
------------------------------------------------
Sub 楕円1_Click()

ActiveSheet.Range("A2:H30").ClearContents

Dim ans, fn, wb, x, i, n, sh, myPath

ans = "○" '条件
myPath = ThisWorkbook.Path & "\"

fn = Dir(myPath & "*.xls") '選択したフォルダ内のExcelファイル
Do Until fn = ""

If fn <> ThisWorkbook.Name Then 'ファイルが当ファイル以外なら

Set wb = Workbooks.Open(myPath & fn) '選択したファイルを開きます
For Each sh In wb.Worksheets '各シートごとに
x = sh.Cells(Rows.Count, 1).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, 1) = sh.Cells(i, "B")
.Cells(n + 1, 2) = sh.Cells(i, "C")
.Cells(n + 1, 3) = sh.Cells(i, "D")
.Cells(n + 1, 4) = sh.Cells(i, "E")
.Cells(n + 1, 5) = sh.Cells(i, "F")

End With
End If
Next i
Next sh

wb.Close (False) '選択したファイルを閉じる

End If

fn = Dir() '次のファイルを検索
Set wb = Nothing

Loop '繰り返し
---------------------------------------------------------

このマクロでは各ファイルの全てのシートを検索していると思うのですが、
全シートを検索していることが問題でしょうか?
検索したいデータは特定のシートにのみ存在するので(全ファイル同じ名前のシートです)
特定のシートのみ検索してくれればそれで良いのですがどう変更すればよいかわかりません。

「For Each sh In wb.Worksheets '各シートごとに」 色々と調べてここを変更してみたのですが
何れもエラーとなり上手くいきませんでした。

どなたか上手く直す方法を教えて下さい。
宜しくお願いします。

A 回答 (1件)

 For Each sh In wb.Worksheets


  '~処理~
 Next sh

シートをひとつずつshに代入してループすることで、全シートを処理しています。直すなら、たとえばこんな感じ↓

・対象シートがひとつで、シート名固定なら
 Set sh = wb.Sheets("hoge")
 '~ 処理 ~

・シート名不定だけど、何か決まりがある
 For Each sh In wb.Worksheets
  If Left(sh.Name, 1) = "x" Then
   '~シート名xから始まる場合のみ処理 ~
  End If
  If sh.Range("A1") = "moge" Then
   '~ A1が"moge"の場合のみ処理 ~
  End If
 Next sh
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


おすすめ情報