大量のCSVデータを行列の変換をしてエクセルデータにまとめる方法について

Question

CSVファイルが4000個ほどあり、VBAを用い、そのファイルの行列変換をして、１つのエクセルファイルにまとめたいのですが、うまくいきません。どなたか教えていただけないでしょうか？

CSVファイルは、以下の様な２列200行位あるものを、２列目のみ取り出し、エクセルファイルには１行(列ではなく)にして取り出したいのです。

変換前データー

A列          　     B列

B013             毛
B014             54
B015             ポリエステル
B016             36
B017             絹
B018             10
B020              0
B022              0
B023             ポリエステル
B024              0
B025             キュプラ
B026              0
B028              0
B030              0
B032              0
　・　　・
　・　　・
　・　　・


取り込み変換後データ

1行：　毛　54　ポリエステル　36　絹　10　0　0　ポリエステル　0 キュプラ　0　0　0　0


のようにしたいのです。
どなたかお教えいただけないでしょうか？
よろしくお願いいたします。

merlionXX · Accepted Answer

4000個もあるんじゃマクロじゃなきゃできませんよね。
次の手順を試してみてください。
その4000個程度のCSVファイルが入っているフォルダーに、以下のマクロを書いたエクセルBOOKを保存してください。（パス取得のため必ず「保存」してください。）
そのフォルダー内の全てのCSVファイルから、B1：B256の範囲のデータを読み込み、エクセルの.Sheets("Sheet1")の１行目から順に転記していきます。
読み込むのをB1：B256としたのは、わたしのエクセルが2007ではないので、行列を入れ替えたとき列が256列までしかないからです。でも200件程度のデータなら大丈夫ですね？

Sub test01()
    Dim myFile As String, MyPath As String '変数宣言
    Dim i As Long
    Dim wb As Workbook
    MyPath = ThisWorkbook.Path & "\" '自分のパスを取得
    myFile = Dir(MyPath & "*.csv", vbNormal) 'パス内のcsvファイル
    Application.ScreenUpdating = False '画面更新停止
    Application.Calculation = xlCalculationManual '自動計算停止
    Do Until myFile = "" '対象ファイルがなくなるまで
        Set wb = Workbooks.Open(MyPath & "\" & myFile) '選択したファイルを開く
        ThisWorkbook.Sheets("Sheet1").Range("A1:IV1").Offset(i).Value = _
        Application.Transpose(wb.Sheets(1).Range("B1:B256").Value) '行列を入れ替えて転記
        i = i + 1 'カウント
        wb.Close (False) '開いたファイルを閉じる
        myFile = Dir '次のファイルを検索
    Loop '繰り返し
    Application.Calculation = xlCalculationAutomatic '自動計算停止解除
    Application.ScreenUpdating = True '画面更新停止解除
    Set wb = Nothing
    MsgBox i & "件のCSVファイルから転記しました。", vbInformation, " " & Environ("UserName") & "さん (o^-')v "
End Sub

n-jun · Answer

Ａ列に半角スペースで区切って連結した値を代入すると解釈しました。
ＣＳＶファイルはブックと同じフォルダにあるとします。

クリップボードを操作する(1)
http://www.officetanaka.net/excel/vba/tips/tips20.htm
【ダイレクトに格納/取得する】
ツール＞参照設定をお忘れなく。

Sub try()
Dim Clip_B As New DataObject
Dim wb As Workbook
Dim r As Range
Dim Fname As String, Fdir As String

Set r = ThisWorkbook.Worksheets("Sheet1").Range("A1")
Fdir = ThisWorkbook.Path & "\"
Fname = Dir(Fdir & "*.csv", vbNormal)

Application.ScreenUpdating = False

Do Until Fname = ""

Set wb = Workbooks.Open(Fdir & Fname)
wb.Worksheets(1).Range("B1:B200").Copy '２００行固定

With Clip_B
.GetFromClipboard
r.Value = Replace(.GetText, vbCrLf, " ")
End With

Application.CutCopyMode = False
wb.Close False

Set r = r.Offset(1)
Fname = Dir()
Loop

Application.ScreenUpdating = True
Set wb = Nothing
Set r = Nothing
End Sub

勘違いでしたらスル～して下さい。

DOUGLAS_ · Answer

＞CSVファイルが4000個ほどあり
とのことですので、[Open ステートメント] を使用して、[シーケンシャル入力モード] で開いた CSVファイル の「２列目のみ取り出し」て横方向に並べました。
　１列目に CSVファイルのファイル名を配置しましたが、不要の場合は
Cells(i, 1) = Replace(MyName, ".CSV", "")
j = 1
の２行を
j = 0
の１行に差し替えてください。

　また、
MyPath = "D:\hoge\hoge\hoge\"
の行は、CSVファイルの保存されたフォルダの「フルパス & "\"」を指定します。
　merlionXX さんの [回答番号：No.2] のように、CSVファイルと同じフォルダに保存したブックで作業をされるときは、
MyPath = ThisWorkbook.Path & "\"
で結構です。

　「On Error Resume Next」・「On Error GoTo 0」の２行は、「２列目」にデータがなかった場合に配列の２番目の要素「Split(InputData, ",")(1)」がなく、インデックス エラーになりますので、エラー処理を施しています。

　なお、コーディングは、[Dir 関数]・[EOF 関数] の使用例を参考にして書きました。
　同一フォルダに「250行×3列」の CSVファイル を256個作成して試行してみましたが、私の低スペックパソコンで作業時間は１８秒（１列目の見出しを省くと１７秒）でした。


Sub ReadCSV()
　Dim MyPath As String
　Dim MyName　As String
　Dim i As Integer, j As Integer
　Dim InputData As String
　Application.ScreenUpdating = False
　Application.Calculation = xlCalculationManual
　MyPath = "D:\hoge\hoge\hoge\"
　MyName = Dir(MyPath & "*.CSV", 3)
　Do While MyName <> ""
　　i = i + 1
　　Cells(i, 1) = Replace(MyName, ".CSV", "")
　　j = 1
　　Open MyPath & MyName For Input As #1
　　Do While Not EOF(1)
　　　j = j + 1
　　　Line Input #1, InputData
　　　On Error Resume Next
　　　Cells(i, j) = Split(InputData, ",")(1)
　　　On Error GoTo 0
　　Loop
　　Close #1
　　MyName = Dir
　Loop
　Application.Calculation = xlCalculationAutomatic
　Application.ScreenUpdating = True
End Sub

shintaro-2 · Answer

VBAでなければならない理由が良くわかりませんが、

要は、Ｂ列を切り出して、改行をカンマに置換すれば済むのではないですか？

MS-Wordやテキストエディタで容易にできることですが

大量のCSVデータを行列の変換をしてエクセルデータにまとめる方法について

4000個もあるんじゃマクロじゃなきゃできませんよね。

Ａ列に半角スペースで区切って連結した値を代入すると解釈しました。

＞CSVファイルが4000個ほどあり

VBAでなければならない理由が良くわかりませんが、

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング