CSVファイルが4000個ほどあり、VBAを用い、そのファイルの行列変換をして、1つのエクセルファイルにまとめたいのですが、うまくいきません。どなたか教えていただけないでしょうか?
CSVファイルは、以下の様な2列200行位あるものを、2列目のみ取り出し、エクセルファイルには1行(列ではなく)にして取り出したいのです。
変換前データー
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
のようにしたいのです。
どなたかお教えいただけないでしょうか?
よろしくお願いいたします。
No.1
- 回答日時:
VBAでなければならない理由が良くわかりませんが、
要は、B列を切り出して、改行をカンマに置換すれば済むのではないですか?
MS-Wordやテキストエディタで容易にできることですが
No.2ベストアンサー
- 回答日時:
4000個もあるんじゃマクロじゃなきゃできませんよね。
次の手順を試してみてください。
その4000個程度のCSVファイルが入っているフォルダーに、以下のマクロを書いたエクセルBOOKを保存してください。(パス取得のため必ず「保存」してください。)
そのフォルダー内の全てのCSVファイルから、B1:B256の範囲のデータを読み込み、エクセルの.Sheets("Sheet1")の1行目から順に転記していきます。
読み込むのを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
No.3
- 回答日時:
>CSVファイルが4000個ほどあり
とのことですので、[Open ステートメント] を使用して、[シーケンシャル入力モード] で開いた CSVファイル の「2列目のみ取り出し」て横方向に並べました。
1列目に CSVファイルのファイル名を配置しましたが、不要の場合は
Cells(i, 1) = Replace(MyName, ".CSV", "")
j = 1
の2行を
j = 0
の1行に差し替えてください。
また、
MyPath = "D:\hoge\hoge\hoge\"
の行は、CSVファイルの保存されたフォルダの「フルパス & "\"」を指定します。
merlionXX さんの [回答番号:No.2] のように、CSVファイルと同じフォルダに保存したブックで作業をされるときは、
MyPath = ThisWorkbook.Path & "\"
で結構です。
「On Error Resume Next」・「On Error GoTo 0」の2行は、「2列目」にデータがなかった場合に配列の2番目の要素「Split(InputData, ",")(1)」がなく、インデックス エラーになりますので、エラー処理を施しています。
なお、コーディングは、[Dir 関数]・[EOF 関数] の使用例を参考にして書きました。
同一フォルダに「250行×3列」の CSVファイル を256個作成して試行してみましたが、私の低スペックパソコンで作業時間は18秒(1列目の見出しを省くと17秒)でした。
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
ご教授ありがとうございました。
あの後データが15000件に膨らみましたが、
スムーズに取り込むことができました。
本当に助かりました。
ありがとうございました。
No.4
- 回答日時:
A列に半角スペースで区切って連結した値を代入すると解釈しました。
CSVファイルはブックと同じフォルダにあるとします。
クリップボードを操作する(1)
http://www.officetanaka.net/excel/vba/tips/tips2 …
【ダイレクトに格納/取得する】
ツール>参照設定をお忘れなく。
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 '200行固定
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
勘違いでしたらスル~して下さい。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
許せない心理テスト
私は「あなたの目の前にケーキがあります。ろうそくは何本刺さっていますか」と言われ「12本」と答えたら…
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
複数のCSVファイルを横に並べてひとつのエクセルファイルへ結合する方法
Excel(エクセル)
-
行列を入れ替えるができません。制限があるのでしょうか?
Excel(エクセル)
-
csvデータの列の入れ替えができるソフト
その他(ソフトウェア)
-
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
WEBクエリが使えない場合のHPデ...
-
共有フォルダに誰が何にアクセ...
-
エクセルについて コンテンツ...
-
【Excel】[Expression.Error] ...
-
Batch: フォルダ内の特定のファ...
-
特定のエクセルファイルを起動...
-
excelを共有ファイルにすると行...
-
vbsでゴミ箱への移動
-
VBAでCSVファイルが使用中かど...
-
VB6.0でファイルの一行だけ削除...
-
WAVファイルの結合
-
mdbファイル フォームを開くと...
-
エクセルのファイルで、上書き...
-
(Excelマクロ)datファイルをエ...
-
ネットワーク上のmdbファイルへ...
-
Excel VBA 処理後データが重た...
-
月が変わったら自動でシートが...
-
相手のPCにVBAからメッセ...
-
メールで送られてきたワードの...
-
tmpファイル なぜできる?削除...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【Excel】[Expression.Error] ...
-
共有フォルダに誰が何にアクセ...
-
特定のエクセルファイルを起動...
-
VBAでCSVファイルが使用中かど...
-
Batch: フォルダ内の特定のファ...
-
AccessVBAで作成したExcelファ...
-
月が変わったら自動でシートが...
-
excelを共有ファイルにすると行...
-
(Excelマクロ)datファイルをエ...
-
Access VBA を利用して、フォル...
-
【アクセス】「ほかのユーザー...
-
Excel VBA 処理後データが重た...
-
tmpファイル なぜできる?削除...
-
社内Excel共有ブックでの保存ト...
-
mdbファイル フォームを開くと...
-
Access2007でldbファイルが...
-
Dream weaverで、誤ってファイ...
-
XMLデータを変換し印刷する方法
-
大量のCSVデータを行列の変換を...
-
ファイルの途中に文字列を挿入
おすすめ情報