複数条件で検索・抽出し、別シートに順次保存したい

Question

・exel 2003
過去事例を参考にvbaでやってみているのですが、
勉強しはじめの自分に荷が重いようで、相談いたします。

日付　時刻　 緯度　 経度　回数
0531  1731  141.4   35.6   2 
0531  2027  146.6   38.7   1
0531  2343  145.5   36.4   1
・　　・　　　・　　・　　・
・　  ・　　　・　　・　　・
上のような中身のcsvファイルがたくさん（0531.csv　etc）に入っているフォルダがあります。その中のファイルをまずひとつ開き、ある条件で検索、抽出します。その後、その結果を別ブック（Book1）のシートにコピーし、csvファイルを閉じます。また残りのcsvファイルについても開いていき同様の処理を行いたいのですが、処理結果を先ほどのBook1のシートに上から順にどんどん付加していきたいと考えています。こういった処理はどのような流れで書いたらよろしいのでしょうか、具体的にお教え願えないでしょうか。

・ある条件とは上表を例にすると、緯度が141.4より大きく、146.6より小さいもの、かつ経度が35.6より大きく、38.7より小さいものといった条件です（ここでは３行目のデータが抽出されるはず）。
・配列で読み込んでsplitすればいいと思いましたが、抽出後は文字列でしか表示されない。どうにか数字で読み込ませることができないのか。
・また処理ファイルがたくさんあるため、別Bookが65536行を超えたときにどうしたらいいのかも悩んでいます。

hotosys · Accepted Answer

１ファイルが65536行より少なくて、全部で65536行を超えない場合です。

65536行を超える場合は・・・Excel2007を用意するのをお勧めします。（ただし使い勝手で苦労するかも知れませんが）
Sub sample()
Dim dataFolder As String
Dim dataSheet As Worksheet
Dim tempSheet As Worksheet
Dim workLastRow As Long
Dim dataLastRow As Long
Dim dataFile As String
Set dataSheet = Sheets("Sheet1") 'データ集計シート
dataFolder = "c:\data\" 'csvデータのあるフォルダ
Application.ScreenUpdating = False
Set tempSheet = Worksheets.Add
dataSheet.Cells.Delete
dataSheet.Range("A1:E1") = Array("日付", "時刻", "緯度", "経度", "回数")
dataFile = Dir(dataFolder & "*.csv", vbNormal)
Do While dataFile <> ""
tempSheet.Cells.Delete
With tempSheet.QueryTables.Add(Connection:="TEXT;" & dataFolder & dataFile, Destination:=tempSheet.Range("A1"))
.TextFileStartRow = 1
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True '空白区切りで無い場合はいらない
.TextFileTabDelimiter = True 'TAB区切りで無い場合はいらない
.Refresh
End With
workLastRow = tempSheet.Range("A" & Rows.Count).End(xlUp).Row
tempSheet.Range("F2:F" & workLastRow).Formula = "=IF(AND(C2>141.4,C2<146.6,D2>35.6,D2<38.7),1,0)" '検索条件(C2:緯度 D2:経度)
tempSheet.Range("A1:F" & workLastRow).AutoFilter Field:=6, Criteria1:="1"
dataLastRow = dataSheet.Range("A" & Rows.Count).End(xlUp).Row
tempSheet.Range("A2:E" & workLastRow).Copy Destination:=dataSheet.Range("A" & dataLastRow + 1)
dataFile = Dir
Loop
Application.DisplayAlerts = False
tempSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

p.s.
csvの１行目に見出し（「日付,時刻,緯度,経度,回数」）がある場合です。（質問のデータにはあるので）
質問のデータが空白（TAB？）区切りにも見えるので、それでも分けるようにしてます。

fujillin · Answer

だいたい、↓こんなイメージで分割して考えてゆけばよいのでは？

（1）記録するシートをクリアし、カウンタを1（または0）にセット
（2）フォルダ内のcsvファイルを検索し、これに対してループを回す。
　　（Dirなどを利用すれば可能）
----ここからループ内（=1ファイル分の処理）----
（3）ファイルオープン
----ここから内側のループ処理（=1データ分の処理）----
（4）1行読込み、splitでデータ取得
（5）条件にあうか判定
　　（文字の数値への変換はValで可能です。ただし数値でないと後でエ
　　ラーになるので、先にIsNumericなどで数値かチェックしておくと良い
　　でしょう）
（6）条件に合う場合は・・
　　カウンタをインクリメントしてオーバーフローしていれば・・
　　・新しいシートを作成、または、6列分シフトする。カウンタをリセット
　　（列をシフトする場合は、列用のカウンタも用意しておくと便利。カウ
　　　ンタ1つでも計算可能ですが、有効桁数の関係もあるので2個にしてお
　　　くほうがおすすめ。
　　　2個目のカウンタのオーバーフローチェックも必要。）
（7）該当データをシートのカウンタ行（列）などに記録
　　（次のデータへ）
---内側のループ終了----
（8）ファイルクローズ
　　（次のファイルへ）
---外側のループ終了----
（9）その他の処理（適宜）
　　（Book1を保存するとか・・）

imogasi · Answer

あるフォルダ内のCSVファイルをすべて捕まえるコード（FsoのFor EachかDir()の結果がなし、など）
もし他種のファイルが混じっているときは、CSVファイルを選別（拡張子で）
CSVファイルを開き・読むコード（Open　LineInputなど）
レコードの終わりの捕まえ方・クローズ（閉じるのコード（Eof(1)）
レコードをカンマでSplit（VBのSplit関数）
条件をかけて、該当を探すコード（IfステートメントとAnd条件）
ブックを開き、シートに書き込むコード。
エクセルのシートの書き込む位置（行）はポインタ的変数で＋１して順次下行を指すようにする。
ブックの保存とクロースと終了（SaveAs,Close,Quit)
ーー
レコードを配列に入れないほうが良い（必要ない）。
＞別ブック（Book1）のシートにコピー
コピーではなく値の代入でよい。
＞どうにか数字で読み込ませることができないのか
CSVファイルはテキストのファイル。Split後エクセルのセルの値に代入するとき数値に変換すればよい。
＝＝＝＝＝
こんな課題はWEBにコードがある。ここへ質問する前にGoogleででも調べまくること。
もっと質問がブレークダウンした細部についてのものになるはず。

<csv>複数条件で検索・抽出し、別シートに順次保存したい

１ファイルが65536行より少なくて、全部で65536行を超えない場合です。

この回答への補足

だいたい、↓こんなイメージで分割して考えてゆけばよいのでは？

この回答への補足

あるフォルダ内のCSVファイルをすべて捕まえるコード（FsoのFor EachかDir()の結果がなし、など）

この回答への補足

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

関連するカテゴリからQ&Aを探す

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

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング