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

質問

・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行を超えたときにどうしたらいいのかも悩んでいます。

回答No.3

hotosys · ベストアンサー

１ファイルが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？）区切りにも見えるので、それでも分けるようにしてます。

お礼

なんとか解読できました！
いろいろな処理の方法があるのですね、びっくりの連続でした。
処理時間も早い気がします！
ただ「１」のみを抜き出すはずが、オートフィルタで該当無しのファイル（「０」のみのファイル）では、そのファイル内のすべてのデータを抜き出しているようです。いろいろ調べて下記のようにif文で制限をかけましたが、まだ「０」も含んだ形でしか抽出できていません。なにか対策はないのでしょうか。おんぶに抱っこですいません・・

tempSheet.Range("A1:F" & workLastRow).AutoFilter Field:=6, Criteria1:="1"

If tempSheet.Range("A1:F" & workLastRow).SpecialCells(xlCellTypeVisible).Count >= 2 Then
dataLastRow = dataSheet.Range("A" & Rows.Count).End(xlUp).Row
tempSheet.Range("A2:F" & workLastRow).Copy Destination:=dataSheet.Range("A" & dataLastRow + 1)
End If

補足

詳細な回答ありがとうございます。
自分のＰＣは2007なのですが、残念ながら動かすＰＣが2003なのです。
たしかにどのデータにも見出しがあり、出力したデータの一番上にひとつあれば一番いいなと思っています。なおカンマ区切りです（説明不足ですみません）。

なにやらすごいコードのようですが、つたない知識しか無く、ゆっくりと解読している状態です。がんばってみます。

回答No.2

fujillin

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

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

お礼

↑調べた結果、自己解決できました。
結局、hotosysさんの方法でなんとか考えていたものができました。悩んでいた点も可視セルの数(workLastcell)を用いてifで分岐させることでクリアできました。流れが全然浮かばないなかで回答してくださったお三方、とても勉強になりました、ありがとうございます。

workLastcell = tempSheet.Range("A" & Rows.Count).End(xlUp).Row
If workLastcell > 1 Then '検索結果無しの時は１となる
dataLastRow = dataSheet.Range("A" & Rows.Count).End(xlUp).Row
tempSheet.Range("A2:F" & workLastRow).Copy Destination:=dataSheet.Range("A" & dataLastRow + 1)
End If

補足

アドバイスも含んだ回答ありがとうございます。

いま(4)のsplitで読み込んだものを、どう検索したらいいのか悩んでいます。他回答者さんより配列使わなくてもいいとのことすが、できなくて現在、下記のようにしています。mytxtに入ったデータを「,」で区切り、セルに出力し、範囲選択し、valで数値変換しようとしたらだめでした。
do until EOF(変数)
data()=split(mytxt,",")
data1()=val(data())
range("data1()").select
cells(変数+i,1).resize(,Ubound(data1())-Lbound(data1())+1)
_.value=data1()
i=i+1
loop

変数mytxtにデータ格納した状態で、数値へ変換できるのでしょうか
。なにか常套手段があるのでしょうか。もう少しがんばってみます。

回答No.1

imogasi

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

補足

すばやい回答ありがとうございます。
＞もっと質問がブレークダウンした細部についてのものになるはず
確かに細部の具体的な質問になると思います。すいませんでした。いま回答の流れを参考にやってみています。ifステートメント部分検索部分でうまく検索できないのと、数値変換がうまくいきません。もう少しがんばってみます。