Sub TEST1()
Range("A2:D1000").Clear 'シートを初期化
Dim A
'ファイルパスを指定
A = ThisWorkbook.Path & "\TEST\TEST1.xlsx"
Workbooks.Open A 'ファイルを開く
j = 1
With ActiveWorkbook.Sheets(1)
For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(i, "B") = "A" Then '商品が「A」の場合
j = j + 1
'値を抽出
ThisWorkbook.Sheets(1).Cells(j, "A").Resize(, 4) = .Cells(i, "A").Resize(, 4).Value
End If
Next
End With
ActiveWorkbook.Close False 'ブックを閉じる
End Sub
1つのブックから商品が「A」である値を抽出します。
1つのブックから値を抽出する
実行すると、1つのブックから商品が「A」である値を抽出できます。
1つのブックから値を抽出できる
1つのブックから商品が「A」である値を抽出できました。
Dir関数を使って1つのブックから値を抽出
次は、「Dir関数」を使って1つのブックから値を抽出してみます。
Sub TEST2()
Range("A2:D1000").Clear 'シートを初期化
Dim A
'フォルダ内の1つのファイル名を取得
A = Dir(ThisWorkbook.Path & "\TEST\*")
Workbooks.Open ThisWorkbook.Path & "\TEST\" & A 'ファイルを開く
j = 1
With ActiveWorkbook.Sheets(1)
For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(i, "B") = "A" Then '商品が「A」の場合
j = j + 1
'値を抽出
ThisWorkbook.Sheets(1).Cells(j, "A").Resize(, 4) = .Cells(i, "A").Resize(, 4).Value
End If
Next
End With
ActiveWorkbook.Close False 'ブックを閉じる
A = Dir()
End Sub
Dir関数を使って、1つのブックから商品が「A」である値を抽出します。
1つのブックから値を抽出する
実行すると、Dir関数を使って、1つのブックから商品が「A」である値を抽出できます。
1つのブックから値を抽出できる
Dir関数を使って、1つのブックから商品が「A」である値を抽出できました。
Dir関数を使って複数ブックから値を抽出
Dir関数をループすることで、複数ブックから値を抽出します。
VBAコードは、次のようになります。
Sub TEST3()
Range("A2:D1000").Clear 'シートをクリア
Dim A
'フォルダ内の1つのブック名を取得
A = Dir(ThisWorkbook.Path & "\TEST\*")
j = 1
'フォルダ内のブックをループ
Do While A <> ""
Workbooks.Open ThisWorkbook.Path & "\TEST\" & A 'ブックを開く
With ActiveWorkbook.Sheets(1)
For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(i, "B") = "A" Then '商品が「A」の場合
j = j + 1
'値を抽出
ThisWorkbook.Sheets(1).Cells(j, "A").Resize(, 4) = .Cells(i, "A").Resize(, 4).Value
End If
Next
End With
ActiveWorkbook.Close False 'ブックを閉じる
A = Dir() '次のファイル名を取得
Loop
End Sub
実行すると、Dir関数をループして、複数ブックから値を抽出できます。
複数ブックから値を抽出できる
Dir関数をループして、複数ブックから値を抽出できました。
InputBoxを使って検索する値を入力
検索する値を、InputBoxを使って入力できるようにします。
Sub TEST4()
Dim B
'インプットボックスで値を取得
B = InputBox("抽出したい値を入力してください", "確認")
If B = "" Then Exit Sub
Range("A2:D1000").Clear 'シートをクリア
Dim A
'フォルダ内の1つのファイル名を取得
A = Dir(ThisWorkbook.Path & "\TEST\*")
j = 1
'フォルダ内のブックをループ
Do While A <> ""
Workbooks.Open ThisWorkbook.Path & "\TEST\" & A 'ファイルを開く
With ActiveWorkbook.Sheets(1)
For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(i, "B") = B Then '商品が入力した値に一致する場合
j = j + 1
'値を抽出
ThisWorkbook.Sheets(1).Cells(j, "A").Resize(, 4) = .Cells(i, "A").Resize(, 4).Value
End If
Next
End With
ActiveWorkbook.Close False 'ブックを閉じる
A = Dir() '次のファイル名を取得
Loop
End Sub