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

質問です。
A列 B列 ? P列
ユーザID コード
111111 3A1BEW
222222 3A280W
333333 3A3XWZ
以上のようなデータのCSVファイルがあります。1行目は項目、2行目からデータ(1グループ2万件位)、列はA列からP列まであります。B列のコード項目をグループごとに別ファイルにコード名でファイルを自動的につくり、そこに項目AからPまでとそのグループごとのデータをコピーして収納できるマクロができますか。
ファイル名が3A1BEWで項目とグループのデータ
ユーザID コード
111111 3A1BEW

ファイル名が3A280Wで項目とグループのデータ
ユーザID コード
222222 3A280W

ファイル名が3A3XWZで項目とグループのデータ
ユーザID コード
333333 3A3XWZ

よろしくおねがいします。

●質問者: inosisi
●カテゴリ:コンピュータ インターネット
✍キーワード:グループ コピー コード データ ファイル
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● うぃんど
●15ポイント

Excelに読み込んでからだと何かと問題になる可能性がありそうなので、テキストファイルとして処理する方法を選択しています

沢山のファイルを一度に処理したい場合には以前回答いただいたようにmainのほうでdir関数を用いてファイル一覧を取得するように改造してください

csv_splitを呼び出すパラメータは元になるcsvファイルと、書き出す先のフォルダです

Option Explicit

Sub main()
 Call csv_split("z:\a.csv", "z:\")
End Sub

Sub csv_split(csvFileName As String, folderName As String)
 Dim FSO As Object, readFileStream As Object, writeFileStream As Object
 Dim r As String, c() As String, c1() As String, f As String
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set readFileStream = FSO.OpenTextFile(csvFileName, 1)
 Do Until readFileStream.AtEndOfStream
 r = readFileStream.ReadLine
 c = Split(r, ",")
 c1 = Split(c(1), """")
 Set writeFileStream = FSO.OpenTextFile(folderName & c1(1) & ".csv", 8, True)
 writeFileStream.WriteLine r
 Set writeFileStream = Nothing
 Loop
End Sub

2 ● きゃづみぃ
●50ポイント ベストアンサー

指定したフォルダ内にある csvのファイルを一括して処理します。

Sub main()
Dim p As String
'対象フォルダを指定してください。
'このフォルダに この実行用のブックは 入れないでください。

p = "C:\test\"

'処理対象となる拡張子を指定して 呼び出します。
Call jikkou(p, "csv")

End Sub


Sub jikkou(p As String, s As String)

Dim bk_name As Workbook
Application.DisplayAlerts = False
 
f = Dir(p & "*." & s, vbNormal)

Do While f <> ""
 Set w = Workbooks.Open(Filename:=p & f, UpdateLinks:=False, ReadOnly:=False)
  '処理対象は 1番目のシートのみ。
 
 With w.Sheets(1)
 
 For b = 2 To .Range("B2").End(xlDown).Row
 If .Cells(b, "B") <> "" Then
 c = .Cells(b, "B")
 .Cells(2, "B") = c
 Set bk_name = Workbooks.Add

 w.Activate
 .Columns("A:P").Select
 .Columns("A:P").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("B1:B2"), CopyToRange:=bk_name.Sheets(1).Range("A1")
 
 bk_name.SaveAs Filename:=p & c & ".csv", FileFormat:=xlCSV, CreateBackup:=False
 bk_name.Close
 
 .Columns("B:B").Replace What:=c, Replacement:="", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False
 
 End If
 Next b

 End With
 
 w.Close
 
 f = Dir
Loop

Application.DisplayAlerts = True

End Sub

◎質問者からの返答

ありがとうございます。

上手くいったんですが最後に

Micrsoft Visual Basic

× 400

ok ヘルプ

という画面がでてくるのは

なにがおかしいのでしょうか。

そして最後に

最後に作ったファイルと同じものがBook 38 に作ってあり

変更保存しますかと聞いてきています。

よろしくお願いします。


3 ● うぃんど
●15ポイント

「1行目は項目」を見逃していました。訂正版です

追記型なので書き出し先のフォルダはあらかじめ空っぽにしておいてください

(機械的に削除してしまうことも可能ですがデータ保全の面で、手動削除を推奨しておきます)

Option Explicit

Sub main()
 Call csv_split("z:\a.csv", "z:\")
End Sub

Sub csv_split(csvFileName As String, folderName As String)
 Dim FSO As Object, readFileStream As Object, writeFileStream As Object
 Dim r1 As String, r As String, c() As String, c1() As String, f As String
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set readFileStream = FSO.OpenTextFile(csvFileName, 1)
 r1 = readFileStream.ReadLine
 Do Until readFileStream.AtEndOfStream
 r = readFileStream.ReadLine
 c = Split(r, ",")
 c1 = Split(c(1), """")
 f = folderName & c1(1) & ".csv"
 Debug.Print f
 If FSO.FileExists(f) Then
 Set writeFileStream = FSO.OpenTextFile(f, 8)
 Else
 Set writeFileStream = FSO.OpenTextFile(f, 2, True)
 writeFileStream.WriteLine r1
 End If
 writeFileStream.WriteLine r
 Set writeFileStream = Nothing
 Loop
End Sub
◎質問者からの返答

ありがとうございます。

データを置く場所とマクロを実行する場所とファイル名

が今一つ分かりません

マクロの実行の仕方はよくわかりません。


よろしくお願いします

関連質問


●質問をもっと探す●



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