[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『同じフォルダ内のブックから値を取り出したい』（ぺぺ）
Sub *****()
Range("A2:F1000").Clear
Dim A A = Dir(ThisWorkbook.Path & "\TEST\*")
j = 1 Do While A <> ""
Workbooks.Open ThisWorkbook.Path & "\TEST\" & A
With ActiveWorkbook.Sheets(2)
For i = 2 To .Cells(Rows.Count, "C").End(xlUp).Row
If .Cells(i, "C") = "●●●" Then
j = j + 1
ThisWorkbook.Sheets(3).Cells(j, "A").Resize(, 6) = .Cells(i, "A").Resize(, 6).Value
End If
Next
End With
ActiveWorkbook.Close False
A = Dir() Loop
End Sub
上記でTESTフォルダの中にある複数ブック(xlsx)の中から●●●と一致する値を取り出せた(マクロ有効ブック(xlsm)がデスクトップにある状態)のですが、
マクロ有効ブック(xlsm)をTESTフォルダに移動しマクロを実行したところ、値を取り出すことができませんでした。エラーは出ず空欄のままの状態です。
TESTフォルダには大元のデータがそのまま入っています。
同じフォルダに格納されている状態で値を取り出したいです。
どなたかご教授いただければ幸いです。。
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
ThisWorkbook.Path & "\TEST\*"
は、このエクセルブックがあるフォルダの配下にあるTESTフォルダの配下にあるすべてのファイルを意味しています。
ThisWorkbook.Path & "\TEST\" & A
は、このエクセルブックがあるフォルダの配下にあるTESTフォルダの配下にあるAファイルを意味しています。
もし、エクセルブックをTESTフォルダに移動したのであれば、上記のようなTESTの指定は必要ありません。
※他の部分は見ていません(~~;
（ゆたか） 2023/07/19(水) 10:13:18
返信いただきありがとうございます。
マクロ初挑戦で苦戦しかしていないのですが、"\TEST"を削除とはどのような書き換えになりますでしょうか、、
Dim A A = Dir(ThisWorkbook.Path)
j = 1 Do While A <> ""
Workbooks.Open ThisWorkbook.Path & A
上記だと値は取りだせませんでした。お手数ですが詳細を教えていただくことは可能でしょうか。。
（ぺぺ） 2023/07/19(水) 11:28:33
複数ブックから一致したい値を取り出したい https://www.239-programing.com/cgi-bin/excelvba_bbs.cgi?id=1490 （リンク） 2023/07/19(水) 11:50:59
★マクロ有効ブック(xlsm)がデスクトップにある状態
ThisWorkbook.Path & "\TEST\"
↓ ↓
C:\Users\hoge\デスクトップ \TEST\
★マクロ有効ブック(xlsm)をTESTフォルダに移動
ThisWorkbook.Path & "\TEST\"
↓ ↓
C:\Users\hoge\デスクトップ\TEST \TEST\
したがって、（TESTフォルダにある）自ブックを基準にするなら[\TEST]は要らないよねという話です。
■２
提示のコードについて、フォルダ内の【全ファイル】を対象にしていますが、エクセルブックに限定すべきです。
さらに、エクセルの仕組み上同じ名前のブックは同時に開けませんから、同名ブックは処理の対象外にすべきです。
■３
ということを踏まえると↓のような感じになるとおもいます。
※完成品のプレゼントを意図したものでありません。丸パクリして完成！というのはご遠慮ください。 【ステップ実行】等により研究の上、必要な部分のみご自身のコードに組み込んでください。
Sub 研究用()
Dim ふぉるだぱす As String
Dim ふぁいるめい As String
Dim j As Long, i As Long '★変数宣言すべき
ThisWorkbook.Sheets(3).Range("A2:F1000").Clear '★対象のブック・シートを明確にすべき
ふぉるだぱす = ThisWorkbook.Path & "\TEST\"
ふぁいるめい = Dir(ふぉるだぱす & "*.xls?") '★エクセルブックに限定すべき
j = 1
Do While ふぁいるめい <> ""
If ふぁいるめい <> ThisWorkbook.Name Then '★同名ブックは処理対象外にすべき
With Workbooks.Open(ふぉるだぱす & ふぁいるめい).Sheets(2)
For i = 2 To .Cells(Rows.Count, "C").End(xlUp).Row
If .Cells(i, "C").Value = "●●●" Then
j = j + 1
ThisWorkbook.Sheets(3).Cells(j, "A").Resize(, 6) = .Cells(i, "A").Resize(, 6).Value
End If
Next i
.Parent.Close False
ふぁいるめい = Dir()
End With
End If
Loop
End Sub
■４
なお、上記では1行ずつみていますが、発想を変えて
(1) Ｃ列が "●●●"を【抽出】する (2) ↑をコピーして、ThisWorkbook.Sheets(3)のＡ列に値貼り付けする
というアプローチに変えることで効率化が図れると思います。
（もこな２ ） 2023/07/19(水) 11:51:46
詳細ありがとうございます。勉強します。
（ぺぺ） 2023/07/19(水) 11:55:55
■５
＞上記だと値は取りだせませんでした。
マルチポスト先をつぶさに見てないので、すでに指摘されているかもしれませんが↓が原因でしょう。
誤 Workbooks.Open ThisWorkbook.Path & A 正 Workbooks.Open ThisWorkbook.Path & "\" & A
（もこな２ ） 2023/07/19(水) 12:04:23
A = Dir(ThisWorkbook.Path & "\TEST\*")
から"\TEST"を取り除くと、
A = Dir(ThisWorkbook.Path & "\*")
となります。
Workbooks.Open ThisWorkbook.Path & "\TEST\" & A
から"\TEST"を取り除くと、
Workbooks.Open ThisWorkbook.Path & "\" & A
となります。
しかしながら、もこな２さんがご指摘のように、
そのままでは自分自身(xlsm)を開こうとしてしまうためエラーとなるでしょう。
TESTフォルダに自分自身(xlsm)を入れることにしたので、そのままではうまくいきません。
回避策も、もこな２さんが説明されている通りです。
もこな２さんへ
＞エクセルブックに限定すべきです。
＞同名ブックは処理の対象外にすべきです。
お見事ですm(__)m
（ゆたか） 2023/07/20(木) 10:17:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.