巨大なCSVの加工(指定列のみの抽出)について

下記のような構成のCSVファイルがあります。

"ID","a","b","c","d","e","f","g","h","i","j","k","l","m"
"0001","a","b","c","d","e","f","g","h","i","j","k","l","m"
"0003","a","b","c","d","e","f","g","h","i","j","k","l","m"
"0004","a","b","c","d","e","f","g","h","i","j","k","l","m"




例えば、
ここから"ID"列と"c"列と"f"列のみ抽出して新たなCSVファイルで保存。
という処理を行いたいのですが、行数が5000万行近くあり、ファイルサイズが80GB程あるので
エクセルはおろかアクセスでも開くことができません。
テキストエディタの秀丸64bit版なら開くことができますが、指定列の抽出方法が分かりません。
秀丸のマクロでもVBSでも良く、また膨大な待ち時間がかかっても構わないので実現する方法について
お知恵をお貸しください。

このQ&Aに関連する最新のQ&A

A 回答 (5件)

"ID","a","b","c","d","e","f","g","h","i","j","k","l","m"


"0001","a","b","c","d","e","f","g","h","i","j","k","l","m"
扱いやすいように仕向けるのも手段の一つ。
"ID00","a","b","c","d","e","f","g","h","i","j","k","l","m"
"0001","a","b","c","d","e","f","g","h","i","j","k","l","m"
固定長になるものであれば
C列相当は16文字目から3バイト
F列相当は28文字目から3バイト

実際は固定長ではないのだろうが、
プログラムができるのなら、
そのプログラム技術で取り込みやすいデータに
加工することもできるのではないか。そういう工夫できることはないか。
最終目的でなくても何かできないか探してみる。
・・・のキーワードの後20バイトにC列とF列が
含まれているはず、となればその20バイトだけ抜き出すことで
扱うサイズがグッと減る。
工夫したければ、何か規則性を探す。

1行ずつ読み込んで判定を繰り返すプログラムで十分かと思います。

エクセルにろアクセスにしても
シートやテーブルに格納するだけが手段ではない。
VBAを使えばファイルI/O操作はできます。
    • good
    • 1

VBAでもVBSでもかんたん。


No1の方の書いたとおりにやればできる。
ボクだったら、古典的(失礼)ファイルの開き方の代わりにFileSystemObjectを使うといっただけ。
丸投げは嫌いだから、デバッグしないで載せちゃうけど、こんな感じ

dim fso as new filesystemobject
dim ts1 as textstream
dim ts2 as textstream
dim a as variant
set ts1 =fso.opentextfile("hogehoge.csv",forreading,false)
set ts2 =fso.opentextfile("hogehogeout.csv",forappending,true)
do while not ts1.atendofstream
a = split(ts1.readline,""",""")
ts2.writeline a(0) & """,""" & a(3) & """,""" & a(6) & """
loop
ts1.close: set ts1 = nothing
ts2.close: set ts2 = nothing
set fso = nothing

メンセキジコウ  一応私の知識の範囲で間違いのないよう書いたつもりですが、、、
・vbaもしくはvb6で動くように書いたつもりです。
・デバッグしていないのでエラーが起きる可能性があります。
・ファイルの破損等、不測の事態に対しては責任を負えませんので、バックアップなりコピーとるなりして試してみてください。
・実際に動かすときは、カウンターを組み込んで進捗状況がわかるように知るべきだと思います。
・まずは一万件くらいからやってみて、どのくらい時間がかかるか想定してからやったほうが良いと思います。
・filesystemobjectを使うためには参照設定で、windows scripting runtimeにチェックを入れる必要があります。


余計なことだけど、
・実質6行のプログラムだよ。質問する間に書けちゃうけど、仕事じゃないよね。
・No1さんが手順をきっちり書いてるけど、少しは調べてみたのかな? 
・作ったファイルだって読める代物じゃないと思うけど、どうすんの?→機械で処理するならそちらの処理側に書いたほうがいいじゃないかな?

この回答への補足

まだ理解できてませんが、徐々に調べて進めていきたいと思います。

私はプログラマではありませんので先の方が回答してくださった手順は考え方は理解できましたが、
だからといってどう実現すべきかは分かりませんでした。
しかし具体的なソースを見せていただけて助かります。
もちろん自己責任ということを承知の上ですのでご心配なく。

補足日時:2011/04/20 15:38
    • good
    • 0

(大体件数的に読めないデータを何のために使うのかという問題はさておき)


データを見るからにはきっと何らかのDBから落としたもんなんだよね。
ってことは、DBを操作してほしいデータを抽出しなおすのが本筋。

DBへのアクセス権限がないのであれば、私だったら、fsoのreadlineをつかうかな。
何回もいろんな形で操作する必要があるなら、また、別のDBに突っ込んじゃうとか、
アクセスなどで、リンクテーブル作っちゃうとか言う方法もあるけど。

この回答への補足

件数は5000万件と申し上げております。
アクセスのリンクテーブルでも大きすぎて取り込めなかったはず?(もう一度試してみますが)

カンマ区切りで何番目と何番目と何番目をこのファイルに書き込む、という動作を
1行ずつ最終行まで延々と繰り返すような簡単なロジックで
VBS等で簡単に実現できないでしょうか。
ごく一般的な環境で実現可能な案があれば教えてください。

補足日時:2011/04/20 13:31
    • good
    • 0

フィールド内に改行を含むような場合はPerlの「Text::CSV_XS」モジュール、Rubyの「CSV」モジュールを使った方が圧倒的に楽です。


http://www.ruby-lang.org/ja/man/html/CSV.html
    • good
    • 0

何も悩むことはない。

一旦全レコードを読み込んで処理というエクセル的固定観念に毒されている。昔は1レコードを読んで処理が主流だったのだ。VBAでもVBSでもVB.NETでも旧Basicでもよい下記のためのステートメントがある。
(1)ファイルをオープン(インプトファイルとアウトプットファイル各1つ)
(2)テキストを1レコード読み込む
(3)そのテキストを、カンマをデリミタとして、分離し配列に収納。Split関数利用
(4)第1列、C列、F列(配列インデックスでは0、2、5について新しいファイルに書き出す
(5)EOFまで繰り返し
(6)AT ENDでファイルをクローズ。
Googleででも「VBA テキストファイル オープン」「VBA テキストファイル 読む」「VBA Split関数」「VBA テキストファイル 書く」
などで照会し、勉強すること。
時間はかかるがやむをえない。。全レコーど対象のようだから1回は全レコード読まなければしょうがない。
そもそも3列のファイルをわざわざ作らなくても、別途何か本当の処理するときに他の列を使わなければ仕舞いのようにも思うが。
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセルの質問。同じ数字なら違う列の数字を返す

エクセルについて質問です。
A列は数字が入力されていて、B列はある数字があります。C列にB列と同じような数字を入力していきます。入力したC列の数字が、B列の中にあれば、入力した行にA列の数字をD列に返すことは出来ますか?下記に例を記載します。

A     B     C       D
0  20110210  2010811      
1  20110214  20101025  
2  20110215  2011111    7
3  20110216  2011322 
4  20110217  2011516  
6  20110221  2011325  
7  2011111    20101220  
8  20050223  2011128  


宜しくお願いします。

Aベストアンサー

C列に入力した数字が何処の行にあるかはMATCH関数で判る。
そしてその行のA列をINDEX関数で取ればよい。
問題は見つからないときの処理で式が長くなるが。
例データ A-D列
xyzu
111343
334
221
D2に
=INDEX($A$1:$A$10,MATCH(C2,$B$1:$B$10,0))
B列に該当無いという手当ては、CountIFで0かどうかが良いでしょう。
=IF(COUNTIF($B$2:$B$10,C2)=0,"",INDEX($A$1:$A$10,MATCH(C2,$B$1:$B$10,0)))
もしも空白入力したら、上記でカバーできる。
ーー
Match関数のエラー判定ISERRORも使える。
またMATCH関数の代わりにVLOOKUPも考えられるが、取ってくるA列が、検索するB列より左列にあるため使えない。

Q【VBA】全ての複数シートから指定した列をコピー、新しいブックの1シートに抽出する

図1のような形式のシートが複数シートあります。

行いたいことは、図2のような表を作ることです。
全シートから、図1でいうB列の値だけをコピーし、
新しいブックの1つのシートに"値の貼り付け"をしていきたいです。
二回目以降の貼り付け時には、
コピーしたセルの1つ下のセルから張り付けたいです。

その際、図1の上部にあるシートタイトルやヘッダの部分も、
図2のように分けて表示させたいです。
その他にも、シート名や日付も表示させたいと考えています。
なお、対象ブックのあるパスをセルに入力して
「抽出」等のコマンドボタンをクリックしたら
そのパスを読み込んで抽出処理を行うようにしたいです。

VBAを勉強し始めたばかりでなかなか完成できず困り果てています。
コマンドボタンの配置方法や、クリック時に動作する方法は分かります。
が、セルに入力されたパスを読み込むことに手こずっています。
今まで調べてきたなかで、getPathやgetDirなどを使うんだろうなというイメージですが
動くものを作ることができません。

複数シートが対象なので、for文でシートの終わりまでループを回すことは
想像がつくのですが、実際にコードが書けません。
「こういう考え方で出来る」などでもかまいませんので
何かアドバイスをいただけませんでしょうか。

以上、よろしくお願い致します。

図1のような形式のシートが複数シートあります。

行いたいことは、図2のような表を作ることです。
全シートから、図1でいうB列の値だけをコピーし、
新しいブックの1つのシートに"値の貼り付け"をしていきたいです。
二回目以降の貼り付け時には、
コピーしたセルの1つ下のセルから張り付けたいです。

その際、図1の上部にあるシートタイトルやヘッダの部分も、
図2のように分けて表示させたいです。
その他にも、シート名や日付も表示させたいと考えています。
なお、対象ブックのあるパスを...続きを読む

Aベストアンサー

もう少し詳しく書いたほうがよさそうです。

・図が不鮮明、小さくて読めない
・読み込みたいデータのファイルは一つなのか(一つのファイルに複数シート)、
 複数ファイル(パスを指定した先のフォルダにある全ファイル)なのか、
 で、さらに複数シートなのか
・図2にある日付、元のデータとの関係性が不明。

というわけでざっくりの回答となります。
手作業でやることを考えて書いていってはどうでしょうか。

あくまで一例です。いろいろ組み合わせてみてください。

1) ファイルを開く
 Workbooks.Open FileName:=パス名からのファイル名

2)あるフォルダにある全ファイルを開く
 Dir関数と言うのがあります。
http://officetanaka.net/excel/vba/tips/tips95.htm

たとえば
'---------------------------------------
Sub BBB()
Dim myPath As String, FlNam As String

myPath = "C:\Users\tomoya\Desktop\"
FlNam = Dir(myPath & "*.xlsx")

Do Until FlNam = ""
Workbooks.Open Filename:=myPath & FlNam

FlNam = Dir()
Loop
End Sub
'---------------------------------------

3) あるファイルの全シートをループする
'---------------------------------------
Sub ccc()
Dim k As Integer
For k = 1 To Worksheets.Count
Worksheets(k).Select
Next k

End Sub
'---------------------------------------

4) 最終行を取得する
Dim LstRow As Long
LstRow=Cells(Rows.Count,1).End(xlUp).Row
貼付先は、最終行の次でしょうから、実際には上記に +1 をするとよいでしょう。


5)B8セルから一番下までの範囲を指定する
Dim Rng As Range
Set Rng =Range(Cells(8,2),Cells(8,2).End(xlDown))

もう少し詳しく書いたほうがよさそうです。

・図が不鮮明、小さくて読めない
・読み込みたいデータのファイルは一つなのか(一つのファイルに複数シート)、
 複数ファイル(パスを指定した先のフォルダにある全ファイル)なのか、
 で、さらに複数シートなのか
・図2にある日付、元のデータとの関係性が不明。

というわけでざっくりの回答となります。
手作業でやることを考えて書いていってはどうでしょうか。

あくまで一例です。いろいろ組み合わせてみてください。

1) ファイルを開く
 Workbooks.Open ...続きを読む

Qエクセルの列が数字になってしまった。

エクセルの列が数字になってしまった。

上記の通り、エクセルは普通列がアルファベット、行が数字だと思うのですが、
ある日突然、列がアルファベット表示から数字に変ってしまい、数式を入力しても絶対参照
がうまく使えず元通りに設定し直したいのですが、どのうすればいいのでしょうか?

Aベストアンサー

ツール、オプション、全般、設定、のR1C1参照形式を使用するのチェックを外してみてください。

QVBA 最終行・最終列コピー範囲指定における値のみのコピー

下記コード(複数のシートの纏め)で、値のみをコピーする手法を教えて戴きたくお願いします。

Sub matome()
 Dim Sh
 Dim i As Integer
 Dim lRow As Long, lCol As Long, lRow2 As Long
  Application.ScreenUpdating = False
 
 '----列見出しをコピーします
  Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
  '----コピーする順番にシート名を配列Shに登録します
  Sh = Array("Sheet1", "Sheet2", "Sheet3")
  For i = LBound(Sh) To UBound(Sh)
    With Worksheets(Sh(i))
      lRow = .Cells(Rows.Count, 1).End(xlUp).Row
      lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
      If lRow >= 2 Then
        lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Activate
        .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1)
      End If
    End With
  Next i
  Worksheets(1).Activate
  Range("A1").Select
  Application.ScreenUpdating = True
End Sub

下記コード(複数のシートの纏め)で、値のみをコピーする手法を教えて戴きたくお願いします。

Sub matome()
 Dim Sh
 Dim i As Integer
 Dim lRow As Long, lCol As Long, lRow2 As Long
  Application.ScreenUpdating = False
 
 '----列見出しをコピーします
  Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
  '----コピーする順番にシート名を配列Shに登録します
  Sh = Array("Sheet1", "Sheet2", "Sheet3")
  For i = LBound(Sh) To UBound(Sh)
    With Wo...続きを読む

Aベストアンサー

参考になるかわかりませんが
Sub macro2()
Dim Sh
Dim i As Integer
Dim lRow As Long, lCol As Long, lRow2 As Long
Application.ScreenUpdating = False
'----列見出しをコピーします
Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
'----コピーする順番にシート名を配列Shに登録します
Sh = Array("Sheet1", "Sheet2", "Sheet3")
For i = LBound(Sh) To UBound(Sh)
With Worksheets(Sh(i))
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Range("a1").CurrentRegion.Columns.Count
If lRow >= 2 Then
lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
.Activate
.Range(Cells(2, 1), Cells(lRow, lCol)).Copy
Worksheets(1).Cells(lRow2, 1).PasteSpecial Paste:=xlPasteValues
End If
End With
Next i
Worksheets(1).Activate
Range("A1").Select
Application.ScreenUpdating = True
End Sub

参考になるかわかりませんが
Sub macro2()
Dim Sh
Dim i As Integer
Dim lRow As Long, lCol As Long, lRow2 As Long
Application.ScreenUpdating = False
'----列見出しをコピーします
Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
'----コピーする順番にシート名を配列Shに登録します
Sh = Array("Sheet1", "Sheet2", "Sheet3")
For i = LBound(Sh) To UBound(Sh)
With Worksheets(Sh(i))
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
...続きを読む

QエクセルでA列にある数字の合計が特定の数値を超えたらB列に合計を表示させるには

エクセルについての質問です。
以下の様なエクセルの表でA列の合計が、「10」を超える場合、B列に合計を表示させるには、B列にはどの様な関数を入れれば良いでしょうか。お教えください。
なお、最終行にも合計を表示です。

A列 B列
5
4 9
3
5 8
1
2
1
2 6

VBAを知らないため、何とか、関数で対応できると、大変、助かります。

よろしくお願いいたします。

右側の数字がB列の数字です。
解りにくくて、すみません。

Aベストアンサー

例示のようにならない。
B2セルに
=IF(OR(A3="",SUM(A$1:A3)-SUM(B$1:B1)>10),SUM(A$1:A2)-SUM(B$1:B1),"")
下へオートフィル

解決したいと思うなら、もう少し具体的な説明お願いします。
画面の取り込みは([Alt]+[)[PrintScreen]キーで、ペイント等で貼り付け、加工してください

QA列をテキストファイル名に、B列のみをファイル文書に書き出すマクロ

テストデータとして下記を作りました。
ファイル名をaa1.csvで保存しました。

大島,大阪
古河,豊橋
恩田,岐阜
寒川,福島
桐井,新潟
青井,久留米

上記のCSVファイルをマクロを利用して
1行1ファイルのテキストファイルに出力したいです。

また、出力する形式として、
A列をテキストファイル名に
B列のみをファイル文書に書き出したいです。

1行1ファイルのテキストファイルに出力はできたのですが、
A列とB列がテキストファイルの文章として出力されてしまいます。

A列をテキストファイル名に
B列のみをファイル文書に書き出す
マクロを作成することはできるでしょうか。

Aベストアンサー

以下のようにしてください。
---------------------------------------
'目的のブックのシートを開いたままお使いください。
Sub ColumnOut2Text()
Dim i As Long
Dim j As Long
Dim Fno As Integer
Dim OutColumn As String
'ユーザー設定
Const myPath As String = "C:\ZZZ\"
'かならず、最後に\ を入れてください。
'
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
Fno = FreeFile()
Open myPath & .Cells(i, 1).Value & ".txt" For Output As #Fno
'For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
' OutColumn = .Cells(1, j).Value & Chr(13) & .Cells(i, j).Value & Chr(13)
'Print #Fno, OutColumn
'Next j
'OutColumn = Empty
Print #Fno, .Cells(i, 2).Value 'この行を追加
Close #Fno
Next i
End With
Beep
End Sub
------------------------------------------------
不要な行はコメントアウトしています。
追加した行は、以下の1行です。
Print #Fno, .Cells(i, 2).Value 'この行を追加

尚、sheet1のB列にCSVファイルの2列目のデータ(大阪、豊橋、岐阜等)が格納されていると理解しています。
もし、違っていたら、その旨補足してください。

以下のようにしてください。
---------------------------------------
'目的のブックのシートを開いたままお使いください。
Sub ColumnOut2Text()
Dim i As Long
Dim j As Long
Dim Fno As Integer
Dim OutColumn As String
'ユーザー設定
Const myPath As String = "C:\ZZZ\"
'かならず、最後に\ を入れてください。
'
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
Fno = FreeFile()
Open myPath & .Cells(i, 1).Value & ".txt" For Output As #Fno
'For j = 1 To ....続きを読む

Qエクセル 数字の入っている列をピックアップしたい

エクセルで表を作っており、以下のように各行ばらばらに
違う列に数字が入っています。
また、重複して違う列に数字が入っていることはありません。
この列の中から数字が入っているものを
(入っていないセルは空か0が入っています)
ピックアップした列を作りたいのですが、
適切な関数はありますでしょうか?



 2
  3
   4
    5

Aベストアンサー

1~5がそれぞれAセル~Eセルにあるとすれば、
Fセルに
=a1+b1+c1+d1+e1
と設定して、全行コピーしたらいかがでしょう?
単純すぎますか?

Q重複列があり、その他の列を同じ列にかえす

こういったselect文ってつくれるんでしょうか?
ネットで調べてもこういった答えが見つけられなかったので…
おわかりの方いましたら、よろしくお願いします。

列1  | 列2  | 列3

1    |りんご  |きゅうり
1    |みかん  |なす
2    |かき   |はくさい
2    |なし    |キャベツ
3    |もも    |ごぼう
3    |キウイ  |きのこ



1   |りんご/みかん|きゅうり/なす
2   |かき/なし   |はくさい/キャベツ
3   |もも/キウイ  |ごぼう/きのこ

っていうことがしたいんですが…
列1の重複ごとにまとめて、2、3をまとめて1つの列にいれるような
selectで表示されるような文です。
2、3は一応文字列なので、集計とか考えていないです。

Aベストアンサー

ムリです。

列2の内容を他のレコードの列2とバインドするようなSQLはかけません。用意されていません。
どうしてしたのら、VBとかフォロントエンドで処理をしてください。

Qエクセルで1列に入っている数字を抜き出したい

お世話になります。

エクセルの2003で1列に入っている数字(文字)を別シートで抜き出したいです。
たとえば、
A列
2001
2002
2003
2001
2003
2004
2004
2001
 :
と、バラバラに長く入っています。
これを別のシートに
A列
2001
2002
2003
2004
とまとめたいのです。
個数等は必要ありません。
純粋に入っている数字の種類を飛ばしたいのです。
宜しくお願いいたします。

Aベストアンサー

こんにちは!

データは数値だという前提で・・・

作業用の列を使うのが一番簡単だと思います。
データはA1セルからあるとします。
Sheet1のB列を作業用の列として、
B1セルに
=IF(COUNTIF(A$1:A1,A1)=1,A1,"")
という数式を入れ、これ以上データはない!というくらいしっかり下へオートフィルでコピーしておきます。

そしてSheet2のA1セルに
=IF(COUNT(Sheet1!B:B)<ROW(A1),"",SMALL(Sheet1!B:B,ROW(A1)))
という数式を入れ下へコピー!

こんなんではどうでしょうか?m(_ _)m

QcsvをVBScriptで加工する方法を教えてください。

いつもお世話になっております。
VBScriptを使用して、下記のようなCSVをメールアドレスごとに別々のテキストファイルに書き出したいです。

都道府県名, 担当ブロック名, 担当者名, 電話番号, メールアドレス, ・・・
北海道, 1ブロック, 佐藤 浩二, 090-0000-0001, kjsato@aaa.co.jp
北海道, 2ブロック, 田中 洋子, 090-0000-0002, yktanaka@aaa.co.jp
北海道, 3ブロック, 佐藤 浩二, 090-0000-0001, kjsato@aaa.co.jp
北海道, 4ブロック, 石川 隆, 090-0000-0003, tkshishikawa@aaa.co.jp
(以下略)

上記でいえば、1ブロックと3ブロック担当の佐藤さんのレコードを1つのファイルにまとめて出力。
それ以外の方はそれぞれ別ファイルに出力。

ADODBコネクションを使用するところまでは、なんとなくわかります。
次はメールアドレスをキーにして、SQLで出力、ですかね。。

すみませんが、どなたか具体的な方法をご教示いただけないでしょうか。
以上、よろしくお願いいたします。

いつもお世話になっております。
VBScriptを使用して、下記のようなCSVをメールアドレスごとに別々のテキストファイルに書き出したいです。

都道府県名, 担当ブロック名, 担当者名, 電話番号, メールアドレス, ・・・
北海道, 1ブロック, 佐藤 浩二, 090-0000-0001, kjsato@aaa.co.jp
北海道, 2ブロック, 田中 洋子, 090-0000-0002, yktanaka@aaa.co.jp
北海道, 3ブロック, 佐藤 浩二, 090-0000-0001, kjsato@aaa.co.jp
北海道, 4ブロック, 石川 隆, 090-0000-0003, tkshishikawa@aaa.co.jp
(以下略)
...続きを読む

Aベストアンサー

以下のスクリプトを実行してください。ファイル名は、あなたの環境に合わせてください。
---------------------------------------------
Option Explicit

Dim objFileSystem
Dim objStream
Dim objStream2
Dim strLine
Dim arrFields
Dim mailaddr
Dim header
Dim line()
Dim lineNo
Dim dataNo
Dim datanos
Dim i

Dim mailList
Set mailList = CreateObject("System.Collections.SortedList")

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objStream = objFileSystem.OpenTextFile("d:\goo\vbs\goo2.csv", 1)
Set objStream2 = objFileSystem.OpenTextFile("d:\goo\vbs\result.csv", 2,true)
lineNo = 0
dataNo = 0
Do Until objStream.AtEndOfStream
strLine = objStream.ReadLine
if LineNo = 0 then
header = strLine
else
arrFields = Split(strLine,",")
mailaddr = arrFields(4)
redim preserve line(dataNo)
line(dataNo) = strLine
if mailList.ContainsKey(mailaddr) then
mailList.Item(mailaddr) = mailList.Item(mailaddr) & "," & dataNo
else
mailList.add mailaddr,dataNo
end if
end if
dataNo = dataNo + 1
lineNo = lineNo + 1
Loop

For i =0 To mailList.Count-1
objStream2.WriteLine("")
objStream2.WriteLine(header)
mailaddr = mailList.GetKey(i)
datanos = Split(mailList.Item(mailaddr),",")
For Each dataNo in datanos
objStream2.WriteLine(line(CLng(dataNo)))
next
Next

objStream.Close
objStream2.Close
Set objStream = Nothing
Set objStream2 = Nothing
Set objFileSystem = Nothing
Set mailList = Nothing
---------------------------------------------------------
以下、実行結果です。
goo2.csvの内容
------------------------------
都道府県名, 担当ブロック名, 担当者名, 電話番号, メールアドレス, ・・・
北海道, 1ブロック, 佐藤 浩二, 090-0000-0001, kjsato@aaa.co.jp
北海道, 2ブロック, 田中 洋子, 090-0000-0002, yktanaka@aaa.co.jp
北海道, 3ブロック, 佐藤 浩二, 090-0000-0001, kjsato@aaa.co.jp
北海道, 4ブロック, 石川 隆, 090-0000-0003, tkshishikawa@aaa.co.jp
------------------------------

result.csvの内容
-----------------------------

都道府県名, 担当ブロック名, 担当者名, 電話番号, メールアドレス, ・・・
北海道, 1ブロック, 佐藤 浩二, 090-0000-0001, kjsato@aaa.co.jp
北海道, 3ブロック, 佐藤 浩二, 090-0000-0001, kjsato@aaa.co.jp

都道府県名, 担当ブロック名, 担当者名, 電話番号, メールアドレス, ・・・
北海道, 4ブロック, 石川 隆, 090-0000-0003, tkshishikawa@aaa.co.jp

都道府県名, 担当ブロック名, 担当者名, 電話番号, メールアドレス, ・・・
北海道, 2ブロック, 田中 洋子, 090-0000-0002, yktanaka@aaa.co.jp
--------------------------------------------------------

以下のスクリプトを実行してください。ファイル名は、あなたの環境に合わせてください。
---------------------------------------------
Option Explicit

Dim objFileSystem
Dim objStream
Dim objStream2
Dim strLine
Dim arrFields
Dim mailaddr
Dim header
Dim line()
Dim lineNo
Dim dataNo
Dim datanos
Dim i

Dim mailList
Set mailList = CreateObject("System.Collections.SortedList")

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objStream = objFileSystem.OpenTextFile("...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報