Excel（エクセル）活用コミュのコードで分類して別々のCSVファイルに出力

はじめまして。質問させてください。
Microsoft Office Excel 2003、Windows 2000/XPです。

Webで個人から複数の企業への資料請求をまとめて受け付けるシステムがあります。結果はCSVで送られてきて、担当者がExcelで内容を確認。OKであれば請求先ごとにファイルを切り分けてメールしてます。

送付先としては300件ぐらいありますが、それが毎回すべて含まれるわけではありません。

データの中身は

株式会社A,土屋勝,東京都,新宿区・・・
株式会社B,土屋勝,東京都,新宿区・・・
株式会社A,nossy,東京都,府中市・・・
C株式会社,nossy,東京都,府中市・・・

みたいな感じ。
これを自動化したいのですが行き詰っています。

(1)会社名とコードの表が別にあり、それをvlookup関数で参照して元の表に会社コードを挿入します。
(2)コードでソートします
(3)オートフィルタを実行し、同じ企業に資料請求をしている人を並べます

A001,株式会社A,土屋勝,東京都,新宿区・・・
A001,株式会社A,nossy,東京都,府中市・・・

となります。ここまではできました。
(4)抽出された行を選択してコピーし、別のシートを開いてペーストします。
(5)企業コードをファイル名としてCSVで保存します。
(6)これを最後まで繰り返します。

(4)の、抽出された行を選択するというのが、Ctrl-Aしちゃうと、CSVにしたときに空行が含まれてしまい、ちょっとまずいです。
また、「コードをファイル名として保存」というのが、ちょっとわかりません。
300件ですから、

Selection.AutoFilter Field:=1, Criteria1:="A001"

や

ActiveWorkbook.SaveAs Filename:="C:\usr\local\home\A001.csv" _
, FileFormat:=xlCSV, CreateBackup:=False

を300行ほど書いてやればできそうですが、もっとスマートな方法はないでしょうか。

よろしくお願いします。

コメント(9)

最初
全て
最新の40件

[1] mixiユーザー 02月13日 21:40

職場でないから、手元にソースが無くて申し訳ない。

AutoFilterとSpecialCells(xlCellTypeVisible)でできますよ。

[2] mixiユーザー 02月14日 00:54

> まつりさん
コメントありがとうございました。

Selection.AutoFilter Field:=1, Criteria1:="A001"
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.CurrentRegion.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="C:\usr\local\home\A001.csv", FileFormat _
:=xlCSV, CreateBackup:=False

で必要な行だけをペーストして保存できました。
ただ、企業コードとフィアル名は300行書かないといけないのでしょうかね。
なんか、ここをプログラミングできればスマートなんですが。

[3] mixiユーザー 02月14日 01:25

> ただ、企業コードとフィアル名は300行書かないといけない
そんなことないと思います。
いくつか方法はありますが、、、
フィルタオプションを使って、重複しない企業コードの配列を作ってから、それを利用するなら、こんな感じになります。
Sub Sample1()
　　Const cDir As String = "C:\usr\local\home\"
　　Dim rngI As Range
　　Dim rngU As Range
　　Dim shtA As Worksheet
　　Dim bkS As Workbook
　　Dim aryCode() As String
　　Dim idx As Long
　　Dim i As Long

　　Set shtA = ThisWorkbook.Worksheets("Sheet1")
　　Set rngU = shtA.Range("A1").CurrentRegion

　　' フィルタオプションを使って重複するレコードを無視する
　　rngU.Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
　　idx = -1
　　' Ａ列の可視セルに対してループ
　　For Each rngI In rngU.Columns(1).SpecialCells(Type:=xlCellTypeVisible)
　　　　If rngI.Row > 1 Then
　　　　　　idx = idx + 1
　　　　　　' 配列を拡張して最後の要素にセルの値を入れる
　　　　　　ReDim Preserve aryCode(0 To idx) As String
　　　　　　aryCode(idx) = rngI.Text
　　　　　　Debug.Print idx, aryCode(idx), "DD 確認? DD"
　　　　End If
　　Next rngI
　　' フィルタオプションを解除する
　　shtA.ShowAllData

　　shtA.AutoFilterMode = False
　　For i = 0 To idx
　　　　Debug.Print i, aryCode(i), "DD 確認? DD"
　　　　' オートフィルタをかける
　　　　rngU.AutoFilter Field:=1, Criteria1:=aryCode(i)
　　　　Set bkS = Workbooks.Add
　　　　' フィルタしたセルをコピーする
　　　　shtA.AutoFilter.Range.Copy Destination:=bkS.Worksheets(1).Range("A1")
　　　　' 保存する
　　　　bkS.SaveAs Filename:=cDir & aryCode(i) & ".csv", FileFormat:=xlCSV
　　　　bkS.Close SaveChanges:=False
　　Next i
　　shtA.AutoFilterMode = False
End Sub

[4] mixiユーザー 02月14日 01:31

企業コードでソートして、先頭行から順番に読んで、企業コードが変わった時にそれまでバッファ（テーブル）にためた分をCSVに書き出せばいい感じがします。

ま、COBOL的な書き方ですけど（苦笑）

[5] mixiユーザー 02月14日 17:40

> ビリーさん
ありがとうございます。
ビリーさんのコードでやってみました。

まず、
shtA.ShowAllData
はエラーになってしまったので、コメントアウトしました。

1企業について1人しか応募がない場合はうまくいったのですが、複数人が応募していると
「××という名前のファイルが既にあります」
と表示されてしまいます。

rngU.Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True

なので、企業コードA$が重複しているレコードは無視されるはずなのですが、イミディエイトでDebug.Printを見ると

0 107301 DD 確認? DD
1 108201 DD 確認? DD
2 108401 DD 確認? DD
3 108401 DD 確認? DD
4 109302 DD 確認? DD
5 110801 DD 確認? DD
6 110801 DD 確認? DD
7 111501 DD 確認? DD
8 111501 DD 確認? DD

と、そのまま配列に取り込まれています。そのために同じ名前のファイルを複数回作ろうとしています。
この2点をどうしたらよいでしょうか。

よろしくお願いします。

[6] mixiユーザー 02月14日 18:26

私のコードを変更して使っていませんか？

一般操作で｢データ｣－｢フィルタ｣－｢フィルタオプションの設定｣を試してみてください。
それでうまくいかないなら、実はデータに違いがあるのではないかと思います。

[7] mixiユーザー 02月14日 19:18

ビリーさんのコードの、ディレクトリとシート名を変更しただけです。

デバッグしてみると、コードが重複している行は非表示になっているのに、Type:=xlCellTypeVisibleが無視されて全部が配列に読み込まれているようです。

[8] mixiユーザー 02月14日 22:06

> デバッグしてみると、コードが重複している行は非表示にな
> っているのに、Type:=xlCellTypeVisibleが無視されて全部が
> 配列に読み込まれているようです。
それなら、
　　rngU.Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
の直後に
　　Debug.Print rngU.Columns(1).SpecialCells(Type:=xlCellTypeVisible).Address
を入れるとどうなりますか？

Ａ列のデータの入っているセル範囲全体のアドレスが返ってくるなら、
｢コードが重複している行は非表示｣になっていないし
可視セルのアドレスが返ってくるなら、
｢Type:=xlCellTypeVisibleが無視｣ではないはず。
つまり、どちらが返ってきても矛盾します。
どこかにコードの誤りがあるように思えるのですが…
念のため、確認ですが Option Explicit は付けていますよね？

[9] mixiユーザー 02月16日 19:51

解決しました・・・

A列の企業コードがVLOOKUP関数で他のブックからひっぱてきていたので、引数にB列のセル番号が含まれており、重複データになってませんでした。

いったん企業コードを取ってきた後、全体をコピーして値として貼り付けてからオートフィルタをかけたらうまくいきました。

ビリーさん、ありがとうございました。

ログインすると、みんなのコメントがもっと見れるよ