<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なのです。
たしかにどのデータにも見出しがあり、出力したデータの一番上にひとつあれば一番いいなと思っています。なおカンマ区切りです（説明不足ですみません）。

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