VBAの記述方法について教えていただけると幸いです。

はじめまして、VBAの記述方法に悩んでおります。
行いたい処理としては、

・同じディレクトリに存在する、指定の文字を含むブックを探す
　　　　　　　　　　　　　　　　▼
・存在する場合、そのブックを開いて、指定のセルからアクティブワークブックへコピペする
　　　　　　　　　　　　　　　　▼
・存在しない場合に、次の処理を行う

といった作業を行いたいのですが、思う様にうまくいきません。
勉強不足なのは重々承知ですが、有識者の方の意見をお伺いしたいです。

自分で途中まで書いていたvba▼

Sub TEST1()

If Dir(ThisWorkbook.path & "/*" & "double" & "*.csv") <> "" Then '対象のファイルがあるかどうかの確認
'ある場合
Dim path As String
path = Dir(ThisWorkbook.path & "/*" & "double" & "*.csv")

Workbooks.Open(path).Worksheets(1).Range("B2:B200").Copy ThisWorkbook.Worksheets(1).Range("B2").Value
Workbooks(path).Close savechanges:=False

Else
'ない場合に次の処理に進む（空白でOK？）

End If

End Sub

また、この指定の文字を変えて複数回行う場合は、subそのものを複数個作った方が良いのでしょうか？（調べたい文字のパターンが30個くらいある場合など）


どうかご教授ください。
よろしくお願いいたします。

No.4 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/02/17 19:01

サンプルです。

fnames = Array("double", "data1", "data2", "data3")
の箇所が処理したいファイルの一覧です。あなたのほうで適切に設定してください。
-------------------------------------------
Option Explicit

Public Sub 複数CSVファイル処理()
Dim fnames As Variant 'ファイル名一覧（拡張子なし）
Dim fname As Variant '処理中のファイル名（拡張子なし）
Dim trg_row As Long '転送先の開始行
trg_row = 2
fnames = Array("double", "data1", "data2", "data3")
For Each fname In fnames
Call TEST1(fname, trg_row)
Next
MsgBox ("完了")
End Sub

Private Sub TEST1(ByVal fname, ByRef trg_row As Long)
Dim csvfile As String
csvfile = Dir(ThisWorkbook.path & "\*" & fname & "*.csv")
If csvfile <> "" Then '対象のファイルがあるかどうかの確認
'ある場合
Dim path As String
Dim wb As Workbook
path = ThisWorkbook.path & "\" & csvfile
Set wb = Workbooks.Open(path)
wb.Worksheets(1).Range("B2:B200").Copy ThisWorkbook.Worksheets(1).Range("B" & trg_row)
wb.Close savechanges:=False
trg_row = trg_row + 199
End If
End Sub

この回答へのお礼

情報の足りない質問に、気長にお付き合いいただきありがとうございました。わかりやすいコードで動きがわかりやすかったです。

お礼日時：2022/02/25 13:25

No.5 回答者： Qchan1962 回答日時： 2022/02/18 20:57

こんばんは　No.3です

＞何が適切なのかわかっていない自分には

1点、ご質問とは関係ない事なので書き忘れていました。
csvファイルは区切り文字で構成されたテキストファイルと言う事です
なので、csvファイルを抽出する場合、Workbooks.Open（Excel）で開くのは出来れば避けたいと言う事です。

csvファイルがExcelから作られたファイルであれば、あまり気にすることはありませんが

csvのデータに演算のような文字列や0から始まる数列などがあると
正しく抽出できない可能性があります。文字化けの可能性などもあります。
Excelに抽出するのですから、抽出のどこかで対策する必要があると思われますが、
Workbooks.Openで開くと開いた段階で変更されてしまいますので
対策する事が出来ない事になります。

Workbooks.Openでは無くどの様に抽出するのか、
方法は色々ありますが、私が初めに知ったのは
　Open fileFullpath For Input As #1　です

参考コード
Sub sample_join_csv()
Dim path As String
Dim f As String
Dim buf As String
Dim aryData As Variant
Dim rN As Long ', i As Long

path = ThisWorkbook.path & "\"
f = Dir(path & "*double*" & ".csv")
rN = 2 '2行目から下へ出力
Application.ScreenUpdating = False
Do While f <> "" 'ｆに値がある場合は繰り返す
Open path & f For Input As #1
Line Input #1, buf 'ヘッダ行があるようなので読み飛ばす
'(200行迄限定の場合、下記ループ条件Until EOF(1)を要変更）
Do Until EOF(1) 'データの終端迄
Line Input #1, buf
aryData = Split(buf, ",")
'csvすべてのデータを抽出する場合
'For i = 0 To UBound(aryData)
'aryData(i)の内容で必要に応じて列の書式設定や 'を付加する等　加工
'Worksheets(1).Cells(rN, i + 1) = aryData(i)
'Next
'B列のみは下記1行
Worksheets(1).Cells(rN, 2) = aryData(1)
rN = rN + 1
Loop
Close #1
f = Dir()
Loop
Range("A1").Select
Application.ScreenUpdating = True
End Sub

＞文字のパターンが30個くらい
はファイル名にワイルドカードが指定されている事から、doubleの文字列が含まれるファイルすべてを対象にすれば良いかと判断しました。

コード内のコメントはデータを加工するタイミングやCSVファイルに含まれるすべてのデータを抽出する時などに必要なコード。
書き直す時などの参考コードです
1か所、要変更箇所がありますし詰め込みすぎかもしれませんがどうでしょう。

この回答へのお礼

最後までご丁寧な回答ありがとうございました。
非常に学びになることが多く、感謝いたします。

お礼日時：2022/02/25 13:13

No.3 回答者： Qchan1962 回答日時： 2022/02/17 18:27

こんばんは

1ファイルを開いて処理する所までは出来ているようですので
アドバイスと言う事で

複数回繰り返す場合はFor ~ Next や　Do～Loopなどの繰り返し処理が必要です。

他の方法としては　条件　GoTo　ラベル　などもあります（取敢えず忘れて）

おそらくご質問の内容の場合、For ~ Next　が簡単だと思います

この繰り返し処理内に条件　If文などで分け処理を進めます
処理完了後　Next　で　Forに戻る　ような流れです。

ファイル名でのループになりそうなので　こちらが参考になるかも知れません（あえて少し難しい方を）

https://fastclassinfo.com/entry/vba_fornext_hair …
ご自身でもVBA For ~ Nextなどで調べてみてください
直ぐに理解できると思います。

メインの処理
Workbooks.Open(path).Worksheets(1).Range("B2:B200").Copy ThisWorkbook.Worksheets(1).Range("B2").Value
は　ファイルが変わる度に変更する必要が出て来ます。（同じ所にコピペはまずいですよね）
例えば、最終行につなげるのかな？
B列の最終行の1つ下のセルは
Cells(Rows.Count, "B").End(xlUp).Offset (1)なので

ThisWorkbook.Worksheets(1).Cells(Rows.Count, "B").End(xlUp).Offset (1)　とすれば新規行に追加される形になります
・・・こちらね。

違う出力先
シート名で出力先シートを変えるのが良く見る構造ですが、参考サイトにあるようなfor~Nextを使用するのであれば、ファイル名とシート名の整合性を考えれば、比較的判り易いのではないでしょうか？

＞調べたい文字のパターンが30個くらいある
パターン（規則性）があるのなら、規則に従ってファイルを探せばよい事になるのでもう少し簡単かもしれませんね

いろいろと難しい場合は、
どこか空いているシートの列を利用（セルにファイル名を入れて）してセル範囲をループする方法も考えられます。（これが一番簡単）

長文になってしまいました。コードを書いた方が簡単なのですが
調べながらもう少し頑張れば出来るのではないかと思いますので許してくださいね。

この回答へのお礼

非常に丁寧な回答をありがとうございます。

何が適切なのかわかっていない自分には、コメント全てが面白く勉強になります。

頑張ります。

お礼日時：2022/02/17 18:49

No.2 回答者： tatsumaru77 回答日時： 2022/02/17 18:04

補足要求です。

１．該当ファイルが複数あるケースはないのですか。
例　double1.csv,double5.csv の２つのファイルがあった場合、
提示されたマクロではどちらか一方を処理して終わりですが、
それでよいのでしょうか。それとも２つのファイルを処理するのでしょうか。

２．１つ目のファイルをコピーするとき
copy元　B2：B200
copy先 B2：B200
ですが、２つ目のファイルをコピーするときは
copy元　B2：B200
copy先 B201：B399
となるのでしょうか。

この回答へのお礼

言葉足らずで申し訳ないです、ご丁寧にありがとうございます。

1.については、基本的にないものと考えていただいて問題ないです。
対象となるワイルドカードのファイル名は重複無しです。

2.については、
おっしゃていただいたイメージで問題ないです！

お礼日時：2022/02/17 18:22

No.1 回答者： tatsumaru77 回答日時： 2022/02/17 17:26

>また、この指定の文字を変えて複数回行う場合は、subそのものを複数個作った方が良いのでしょうか？（調べたい文字のパターンが30個くらいある場合など）

１．この文字とは"double"という文字でしょうか。
２．質問の意味は、
double*.csv
hoge*.csv
fuga*.csv
等のようなパターンが３０個くらいあるということですか。
もし、処理の内容が、文字ごとに異なるなら、その文字分のsubを
作ったほうが良いです。
処理の内容が同じなら、１つのsubを作り、そのsubに"double","hoge"など
の文字を引数として渡して処理を行うようにしたほうが良いです。
文字が異なるとき、具体的に、どのように処理の内容が変わるのかが提示されていないので、どちらとも言えません。

この回答へのお礼

ありがとうございます！

言葉不足で申し訳ありませんでした、意図は「2」であっております。
引数での対応納得です。

ご回答いただきありがとうございます。

お礼日時：2022/02/17 17:37