マクロの組み方を教えてください【条件毎にCSVファイルで出力する方法】

質問

初心者で恐縮です。宜しくお願いいたします。
現在下記のようなデータがあるのですが
　　　A　　　　B　　　　C　----
1　りんご　　＠500　　A倉庫
2　りんご　　＠130　　C倉庫

80 みかん　　＠200　　B倉庫

A列の内容(内容は固定できません)ごとにデータを抽出し、各内容ごとに
CSVファイルで保存をしたいのですがVBAの組み方が分かりません。
どなたかご享受いただければ幸いです。宜しくお願いいたします。
例)りんご.csv
　　　A　　　　B　　　　C　----
1　りんご　　＠500　　A倉庫
2　りんご　　＠130　　C倉庫

回答No.2

rivoisu · ベストアンサー

C列”yymmdd"
E列”HHMM”
F列”00000”

えーと私はこの辺はやったことがないので調べてからじゃないとちゃんとしたお答えができないのですが
Format関数を使うことになると思います。
そうすると
　　　　For j = 1 To 5
　　　　　　CSVREC = CSVREC & Cells(i, j)
　　　　　　If j <> 5 Then
　　　　　　　　　　CSVREC = CSVREC & ","
　　　　　　End If
　　　Next
の部分はループを解除して
　　　　CSVREC=Cells(i,1) & ","
　　　　CSVREC=CSVREC & Cells(i,2) & ","
　　　　CSVREC=CSVREC & Format(Cells(i,3),"yymmdd") & ","
　　　　CSVREC=CSVREC & Format(Cells(i,4),"hh:mm") & ","
　　　　CSVREC=CSVREC & Format(Cells(i,5),"00000")
と書くことになると思います。
（Format文字列はいい加減に書いてますから自分で調べてください。イミディエイトウインドウを使ってやってみるとわかると思います。）

お礼

ありがとうございました！
早速やってみます。

回答No.1

rivoisu

こんな感じかな
テストはしていません

Option Explicit
Option Base 1
sub ファイル分割（）
Dim i As Integer
Dim j As Integer
Dim 品名 As String
Dim CSVREC As String
i = 1
While Cells(i, 1) <> ""
　　品名 = Cells(i, 1)
　　Open 品名 & ".csv" For Output As #1
　　While 品名 = Cells(i, 1)
　　　　CSVREC=""
　　　　For j = 1 To 5
　　　　　　CSVREC = CSVREC & Cells(i, j)
　　　　　　If j <> 5 Then
　　　　　　　　　　CSVREC = CSVREC & ","
　　　　　　End If
　　　　Next
　　　　Print #1, CSVREC
　　　　i = i + 1
　　Wend
　　Close #1
Wend
End Sub

おおきなループ(While Wend)
全ての行に対してする処理
この場合A列が1行目から空白になるまで処理をする

　　品名 = Cells(i, 1)
処理のキーを記憶する（最初は"りんご"が入る
その名前でCSVファイルをOpenする
内側のループ(While Wend)
記憶した品名が対象セルと同じあいだ以下の処理をする（"りんご"が続く限り)
for next
CSVデータを組み立てているこの場合1列目から5列目までを","で連結
Print　で一行出力
次の行を対象とする
wendでWhileに戻りキーが同じならもう一度
Wendの次
ファイルのクローズ

じっくりみてね
当然A列はsortされていることが前提です。
品名を記憶してループの制御をしているところは集計処理とかにもよく使います。

内容についての質問があったらどうぞ。

お礼

ありがとうございます！
早速やってみます!!!
早急のご回答ありがとうございました＾＾ノ

補足

ありがとうございました！おかげで実行できました。
Loopを使うのかと思ってたのですが、(While Wend)があるのですね！
勉強になりました。
追加の質問で恐縮なのですが、出力するCSVの書式も設定できますか?
現在元データのExcelでは
C列”yymmdd"
E列”HHMM”
F列”00000”等の書式を設定してあるのですがCSVで出力されると書式がうまくいきません。
本当にご面倒おかけして恐縮なのですが宜しくお願いいたします。