人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

質問です
\test\のホルダーにCSVファイルの元データがあります
\era\のホルダーに分割したCSVファイルを作るマクロをお願いします

●質問者: inosisi
●カテゴリ:コンピュータ インターネット
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● oil999
●100ポイント ベストアンサー

以下のマクロをお試しください。

mainサブルーチンの引数は
1.分割前のCSVファイルのあるディレクトリ名
2.CVSファイルの拡張子
3.分割ファイルを保管するディレクトリ名
の3つで、任意に設定できます。

Option Explicit

'1ファイル処理
Sub convFile(path As String, fname As String, path2 As String)
 Dim buf As String, idx As String, fname2 As Variant
 Dim ix As Long
 Dim dc As Object
 
 Set dc = CreateObject("Scripting.Dictionary")
  'CSVファイル読み込み
 fname = path & fname
 Open fname For Input As #1
 Line Input #1, idx  '見出し行
 Do Until EOF(1)
 Line Input #1, buf
 ix = InStrRev(buf, ",")
 fname2 = Right(buf, Len(buf) - ix)
 buf = Left(buf, ix - 1)
 If (dc.Exists(fname2) = False) Then
 dc.Item(fname2) = buf
 Else
 dc.Item(fname2) = dc.Item(fname2) & vbCrLf & buf
 End If
 Loop
 Close #1
  'ファイル作成
 For Each fname2 In dc.Keys
 Open path2 & fname2 & ".csv" For Output As #2
 Print #2, idx
 Print #2, dc.Item(fname2)
 Close #2
 Next
End Sub

'ファイル探索+処理実行
Sub hogeConv(path As String, ext As String, path2 As String)
 Dim fcol As Object, re As Object
 Dim flist As Variant, remat As Variant
 Dim pat As String
  'サブディレクトリ探索(有効にしたい場合はコメントを消してください)
' Set fcol = CreateObject("Scripting.FileSystemObject").GetFolder(path).SubFolders
' For Each flist In fcol
' Call hogeConv(path & flist.Name & "/", ext, path2)
' Next flist
' Set fcol = Nothing
  '処理対象ファイル探索+処理実行
 Set fcol = CreateObject("Scripting.FileSystemObject").GetFolder(path).Files
 Set re = CreateObject("VBScript.RegExp")
 pat = "\." & ext & "$"
 With re
 .Pattern = pat
 .IgnoreCase = True
 .Global = True
 For Each flist In fcol
 Set remat = .Execute(flist.name)
 If remat.Count > 0 Then Call convFile(path, flist.name, path2)
 Next flist
 End With
 Set re = Nothing
 Set fcol = Nothing
End Sub

Sub main()
 Call hogeConv("C:/test/", "csv", "C:/era/")
End Sub


蛇足ながら、質問に
http://q.hatena.ne.jp/1331203744
の追加質問であることを明記された方がよろしいかと存じます。
他の回答者が回答しにくいだろうと思いますので。


inosisiさんのコメント
ありがとうございます 早速試してみます結果はまた報告させていただきます
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ