VBA 複数のファイルの特定の列だけ取得してマージ

質問

お世話になっております。

VBAで、複数のCSVファイルの特定の列だけを抽出して別のCSVファイルにマージする方法を探しています。
例えば、マージフォルダに1000のCSVファイルがあります。
1000あるファイルのA列とC列だけを抽出して、
それを別の「マージ.CSV」というファイルにA列とB列にマージして一つにしたいのです。
1000のファイルにはA~Qまで値が入っていて、A~Q列の値全て取り込みマージするとデータが重くなってしまうのです。

Unionメソッドを仕様して列を選択するのかなと思うのですが。。。

現在、こちらのコードを参考にしています。
わかる方いましたらよろしくお願いいたします。

Sub csvmerge()
wpath = Range("B3")
wfile = Dir(wpath & "\")
flag = 0
Do While wfile <> ""
If InStr(wfile, ".csv") Then
flag = flag + 1
If flag = 1 Then
FileCopy wpath & "\" & wfile, ThisWorkbook.Path & "\output.csv"
Open ThisWorkbook.Path & "\output.csv" For Output As #1
Close #1
End If
Open ThisWorkbook.Path & "\output.csv" For Append As #1
Open wpath & "\" & wfile For Input As #2
Do Until EOF(2)
Line Input #2, w_str
Print #1, w_str
Loop
Close #2
Close #1
End If
wfile = Dir()
Loop

MsgBox "マージ完了", vbInformation

End Sub

回答No.3

Prome_Lin

「VBScript」による回答ですので、「Windows限定」です。

このプログラムは、プログラムファイルの存在するフォルダ内のすべての「csv」ファイルの列「A」と列「C」のみを抽出し、同じフォルダ内に「Merge.csv」という結果ファイルを作成します。

以下のプログラムを、メモ帳またはテキストエディタに貼り付け、「～.vbs」という名前で保存します（保存する際は、必ず、「文字コード」を「Shift-JIS（ANSI）」で保存してください）。

「～」の部分は、何でもかまいませんが、「.vbs」の部分は、必ず、半角です。

できたプログラムファイル（「～.vbs」ファイル）を、これから処理したい「csv」ファイル群の存在するフォルダに放り込んで、ダブルクリック（「シングルクリック」→「Enter」の方が確実）するだけです。

実行すると、最初に「Start!」と表示しますので、「OK」を押して、スタートしてください。

また、最後に「Finished!」と表示しますので、「OK」を押して、終了してください。

注意事項
４行目、「m = "Shift-JIS" '"UTF-8" "Unicode"」で、「csv」ファイルの文字コードを指定しています。

今は、「Shift-JIS（ANSI）」ですが、ここを、「m = "UTF-8"」とすれば、「UTF-8（BOM付き）」に、「m = "Unicode"」とすれば、「UTF-16LE（BOM付き）」にそれぞれ対応できます（それ以外のプログラムを変更する必要はありません）。

なお、一応、ファイル名を使って、「小さい順」にソートしていますが、「Test_1.csv」、「Test_2.csv」、・・・「Test_10.csv」、「Test_11.csv」のような場合、思ったようにはソートされません。

すなわち、「Test_1.csv」、「Test_10.csv」、「Test_11.csv」、「Test_2.csv」となってしまいます。

「Test_0001.csv」のように、桁数が揃っていれば、もちろん問題なくソートされます。

Option Explicit
Dim a, ai, ao, c, f, gf, m, i, j, so, x
MsgBox("Start!")
m = "Shift-JIS" '"UTF-8" "Unicode"
Set so = CreateObject("Scripting.FileSystemObject")
Set gf = so.GetFolder(so.GetParentFolderName(WScript.ScriptFullName))
c = - 1
For Each f In gf.Files
If LCase(so.GetExtensionName(f)) = "csv" Then
c = c + 1
ReDim Preserve n(c)
n(c) = f.Name
End If
Next
For i = 0 to c - 1
For j = i + 1 to c
If n(i) > n(j) Then
x = n(i)
n(i) = n(j)
n(j) = x
End If
Next
Next
Set ao = CreateObject("ADODB.Stream")
ao.Type = 2
ao.Charset = m
ao.Open
For i = 0 to c
Set ai = CreateObject("ADODB.Stream")
ai.Type = 2
ai.Charset = m
ai.Open
ai.LoadFromFile gf & "\" & n(i)
Do Until ai.EOS
x = ai.ReadText(-2)
a = Split(x, ",")
ao.WriteText a(0) & "," & a(2), 1
Loop
ai.Close
Set ai = Nothing
Next
ao.SaveToFile gf & "\Merge.csv", 2
ao.Close
Set ao = Nothing
Set gf = Nothing
Set so = Nothing
MsgBox("Finished!")

説明が必要でしたら、言ってください。

回答No.2

kkkkkm

No1の補足です

A列B列C列のデータにカンマが存在する場合は正しい結果になりません。
12,324みたいなデータがある場合などです。

回答No.1

kkkkkm

カンマ区切りのCSVだと考えた場合です。変更する部分だけ記載しますので部分変更して試してみてください。

FileCopy wpath & "\" & wfile, ThisWorkbook.Path & "\マージ.csv"
Open ThisWorkbook.Path & "\マージ.csv" For Output As #1
Close #1
End If
Open ThisWorkbook.Path & "\マージ.csv" For Append As #1
Open wpath & "\" & wfile For Input As #2
w_str2 = ""
Do Until EOF(2)
Line Input #2, w_str
w_str2 = Split(w_str, ",")(0)
w_str2 = w_str2 & "," & Split(w_str, ",")(2)
Print #1, w_str2
Loop