【ExcelVBA】300万件越えCSVから条件を満たす行だけ抽出するには？

csvファイルの内容は、
"ID_A","ID_B","C","D","E"　の5列でできたCSVがあります。
1行目は項目名です。
※デフォルトではShift-JIS、改行LFですが、可変可能です。

IDは13桁で、アルファベット大文字小文字、数字が入り混じっています。
ID_AとID_Bはほぼ同一なのですが稀に異なる場合があるのでそれだけ抽出したいのです。

CSVを選択して、ID_AとID_Bが異なる場合のみシートに書き出すようにするには
どうしたらよいでしょうか？
問題は、このCSVは300万行以上あるのでExcelシートで開くには分割する必要があり、
マクロで必要行だけ抽出できれば助かるのですが。。。
※また、最下行には7行のフッター情報が記載されており無視する必要があります。
よろしくお願いいたします。

No.13 回答者： Qchan1962 回答日時： 2020/03/21 03:45

まだ閉じられていませんが、解決していますよね？

＃４で回答しましたが、
気になったのでスレッド汚しですみません。
>CSVを選択して、ID_AとID_Bが異なる場合のみシートに書き出すようにする（5列）
差異は稀とありますが、一応　インデックス1、2、3のシートを用意して
Sub CSV_Test()
Dim TS As Object
Dim Trg_csv As String, strTmp(1 To 1048576, 1 To 5) As String
Dim Ch As Variant, i As Long, j As Long: j = 1
Dim startTime As Double, endTime As Double, processTime As Double
　　Trg_csv = Application.GetOpenFilename("csv,*.csv,all,*.*")
　　If VarType(Trg_csv) = vbBoolean Or Trg_csv = "False" Then Exit Sub
　　Set TS = CreateObject("Scripting.FileSystemObject").OpenTextFile(Trg_csv, 1)
　　startTime = Timer
　　
　　Do Until TS.AtEndOfStream
　　　　i = i + 1
　　　　Ch = Split(TS.ReadLine, ",")
　　　　If Ch(0) <> Ch(1) Then
　　　　　　strTmp(i, 1) = Ch(0)
　　　　　　strTmp(i, 2) = Ch(1)
　　　　　　strTmp(i, 3) = Ch(2)
　　　　　　strTmp(i, 4) = Ch(3)
　　　　　　strTmp(i, 5) = Ch(4)
　　　　End If
　　　　If i = 1000000 Then
　　　　　　Sheets(j).Range("A1").Resize(i, 5).Value = strTmp
　　　　　　i = 0: j = j + 1
　　　　　　Erase strTmp
　　　　End If
　　Loop
　　Sheets(j).Range("A1").Resize(i, 5).Value = strTmp
　　TS.Close
　　endTime = Timer
　　processTime = endTime - startTime
Debug.Print "処理時間：" & processTime
End Sub

CSVを出力するなら、、、、
Sub Extraction_Record()
Dim TS As Object
Dim Trg_csv As String, strTmp As String
Dim Ch As Variant
Dim startTime As Double, endTime As Double, processTime As Double
　　Trg_csv = Application.GetOpenFilename("csv,*.csv,all,*.*")
　　If VarType(Trg_csv) = vbBoolean Then Exit Sub
　　Set TS = CreateObject("Scripting.FileSystemObject").OpenTextFile(Trg_csv, 1)
　　startTime = Timer
　　With CreateObject("ADODB.Stream")
　　　　.Open
　　　　.Type = 2
　　　　.Charset = "UTF-8"
　　　　.WriteText = TS.ReadLine & vbLf
　　　　Do Until TS.AtEndOfStream
　　　　　　strTmp = TS.ReadLine
　　　　　　Ch = Split(strTmp, ",")
　　　　　　If Ch(0) <> Ch(1) Then
　　　　　　　　.WriteText = strTmp & vbLf
　　　　　　End If
　　　　Loop
　　　　.SaveToFile Format$("差分Data") & ".csv", 2
　　　　.Close
　　End With
　　TS.Close
　　endTime = Timer
　　processTime = endTime - startTime
Debug.Print "処理時間：" & processTime
End Sub

No.12 回答者： otaks 回答日時： 2020/03/15 14:21

'VBE - ツールバー - ツール - 参照設定 - Microsoft Scripting Runtimeにチェックしてから、

'以下マクロを実行
Public Function get_diff_line()
　　Dim file_path As String
　　file_path = Application.GetOpenFilename("CSV, *.csv")
　　If file_path = "False" Then
　　　　MsgBox "キャンセルされました"
　　　　Exit Function
　　End If

　　Dim fso As New FileSystemObject
　　Dim f As TextStream
　　Dim str As String
　　
　　Set f = fso.OpenTextFile(file_path)
　　
　　Dim i As Long
　　i = 1
　　
　　Do Until f.AtEndOfLine
　　　　Dim tmp As Variant
　　　　tmp = Split(f.ReadLine, ",")
　　　　If UBound(tmp) = 4 Then
　　　　　　If tmp(0) <> tmp(1) Then
　　　　　　　　ThisWorkbook.ActiveSheet.Cells(i, 1) = tmp(0)
　　　　　　　　ThisWorkbook.ActiveSheet.Cells(i, 2) = tmp(1)
　　　　　　　　ThisWorkbook.ActiveSheet.Cells(i, 3) = tmp(2)
　　　　　　　　ThisWorkbook.ActiveSheet.Cells(i, 4) = tmp(3)
　　　　　　　　ThisWorkbook.ActiveSheet.Cells(i, 5) = tmp(4)
　　　　　　　　i = i + 1
　　　　　　End If
　　　　End If
　　Loop
　　
　　f.Close
　　MsgBox ("fin")
End Function

No.11 回答者： end-u 回答日時： 2020/03/10 16:37

あっ、いたたた XD

try2、try3を　TEST2、TEST3、とかに変更してください
失礼しました

No.10 回答者： end-u 回答日時： 2020/03/10 16:29

新規Bookに標準モジュールを追加して

try2、try3をその標準モジュールにコピペしただけで？
Excelの列表記、A、B、C・・がTRG、つまり13,995列目から始まってしまったと？
1列目から13,994列目はどうなってるんでしょうね？非表示？

コードをコピペしただけでそんな奇怪な現象が発生するのは初めて遭遇しました ;(
Excel再起動またはPCそのものを再起動してからもう一回試してみてもらえませんか

No.9 回答者： end-u 回答日時： 2020/03/09 20:32

> 逆に行頭から英数字混在データの割合が高い場合は文字列データと判断され、

> 数値のみのデータが抽出されません
あいやそんな事はなく、フィールド全体が文字列データと判断される場合は数値のみでも文字列として扱ってくれたかも。

この回答へのお礼

すみません、良く分からなくなりました。
try2、try3を新規ブック　標準モジュールに貼ったら、
A,B,C,,,,のエクセルのラベル表記が「TRG,TRH,TRI,,,」という表記になり、
try2も実行できず、、、
知識不足で申し訳ございません。

お礼日時：2020/03/10 14:43

No.8 回答者： end-u 回答日時： 2020/03/09 20:14

> IDは13桁で、アルファベット大文字小文字、数字が入り混じっています。

これは各データが英数字混在という意味ではないのでしょうか？
例えば#6のコメントのテスト用データのように数字のみ13桁の場合があり、
２行目から数行は数字のみ13桁の割合が高い、というケースに該当するのでしょうか？

a,b,c,d,e
A1111111x1111,A1111111x1111,3,4,5
1111111111111,1111111111111,3,4,5
1111111111111,1111111111111,3,4,5
Z111111111111,X111111111111,3,4,5
1111411111111,1111111111111,3,4,5
1111111111111,1111111111111,3,4,5
1111111111111,1111111111111,3,4,5
1111111111111,1116111111111,3,4,5
AA11111111111,A111111111111,3,4,5

実際もこのテスト用データのような組み合わせなら、フィールド全体が数値データと判断されたため
文字列データが抽出されません
逆に行頭から英数字混在データの割合が高い場合は文字列データと判断され、
数値のみのデータが抽出されません
こういったケースではQueryTablesやADOを使った手法では更に対策しないといけないので、
全レスのtry3を使ってください
速度的には少し遅くなる程度なので実用には耐えれるんじゃないかと思います

No.7 回答者： end-u 回答日時： 2020/03/09 16:25

う～ム :(

> a,b,c,d,e
これフィールド名ですか？
wkSQL(2) = "WHERE [ID_A]<>[ID_B]"
質問文を基にここでフィールド名決め打ちしてますのでテスト用も合わせてほしかったですね

..まあ、いいですけど

Sub try2()
　　Dim wkCsv
　　wkCsv = Application.GetOpenFilename("csv,*.csv,all,*.*")
　　If VarType(wkCsv) = vbBoolean Then Exit Sub
　　Dim p As Long: p = InStrRev(wkCsv, "\")
　　Const ForReading As Long = 1
　　Dim buf() As String

　　With CreateObject("Scripting.FileSystemObject").OpenTextFile(wkCsv, ForReading)
　　　　buf = Split(.ReadLine, ",")
　　　　.Close
　　End With

　　With Sheets.Add
　　　　With .QueryTables.Add(Connection:="ODBC;Driver={Microsoft Text Driver (*.txt; *.csv)};DBQ=" & Left$(wkCsv, p), _
　　　　　　　　　　　　　　　Destination:=.Range("A1"), _
　　　　　　　　　　　　　　　Sql:="SELECT * FROM [" & Mid$(wkCsv, p + 1) & "] WHERE [" & buf(0) & "]<>[" & buf(1) & "]")
　　　　　　.AdjustColumnWidth = False
　　　　　　.Refresh BackgroundQuery:=False
　　　　　　.Delete
　　　　End With
　　End With
End Sub

Sub try3()
　　Dim wkCsv
　　wkCsv = Application.GetOpenFilename("csv,*.csv,all,*.*")
　　If VarType(wkCsv) = vbBoolean Then Exit Sub

　　Const ForReading As Long = 1
　　Const mx　As Long = 1000000
　　Dim fs　　As Object 'Scripting.FileSystemObject
　　Dim ts　　As Object 'Scripting.TextStream
　　Dim tmp　 As String
　　Dim buf() As String
　　Dim x　　 As Long
　　Dim y　　 As Long
　　Dim i　　 As Long

　　Set fs = CreateObject("Scripting.FileSystemObject")
　　Set ts = fs.OpenTextFile(wkCsv, ForReading)
　　tmp = ts.ReadLine
　　buf = Split(tmp, ",")
　　x = UBound(buf)
　　ReDim ret(mx, x) As String

　　For i = 0 To x
　　　　ret(0, i) = buf(i)
　　Next

　　Do Until ts.AtEndOfStream
　　　　tmp = ts.ReadLine
　　　　If Mid$(tmp, 1, 13) <> Mid$(tmp, 15, 13) Then
　　　　　　y = y + 1
　　　　　　buf = Split(tmp, ",")
　　　　　　For i = 0 To x
　　　　　　　　ret(y, i) = buf(i)
　　　　　　Next
　　　　　　If y = mx Then
　　　　　　　　Sheets.Add.Range("A1").Resize(y + 1, x + 1).Value = ret
　　　　　　　　y = 0
　　　　　　End If
　　　　End If
　　Loop

　　ts.Close
　　Sheets.Add.Range("A1").Resize(y + 1, x + 1).Value = ret
End Sub

他の方からも具体策が出てますから試すなりなんなりリアクションされた方が良いかと思います

この回答へのお礼

いや、大変失礼いたしました。
1行目は無視するだけで、項目名は動作に関係ないと見過ごしてました。
No.5、6 では項目名が「ID_A、ID_B」という前提だったんですね、
ちゃんと中身を見て今気づきました、申し訳ございません。
新たに提示していただいたソースは、その項目名に関わらず抽出できるようにしてくださったんですね？ありがとうございます！

私のサンプルCSVの項目名を「ID_A、ID_B」に修正したら、No.5のソースで動作しました。失礼いたしました。

ただし、求める結果ではなかったので報告します。
↓こういうデータで試したのですが抽出されませんでした。本来抽出されるべきなのですが。
AA11111111111,A111111111111,3,4,5

お礼日時：2020/03/09 18:54

No.6 回答者： end-u 回答日時： 2020/03/05 19:08

> SQL構文エラー..

ですか。では
>wkSQL(1) = Mid$(x, p + 1)
wkSQL(1) = "[" & Mid$(x, p + 1) & "]"
変更してみてください

また念の為QueryTables.Addの前に
Debug.Print Join(wkSQL)
など、SQL文字列確認してみてください
ファイル名に特殊文字が使われているんじゃないでしょうか

この回答へのお礼

ありがとうございます。

一般ODBCエラーとなりました。
該当項目は、
wkQRY.Refresh BackgroundQuery:=False
でした。

ちなみにテスト用に用意したCSVファイルは
ファイル名：abc.csv

中身は、この通りです。

a,b,c,d,e
A1111111x1111,A1111111x1111,3,4,5
1111111111111,1111111111111,3,4,5
1111111111111,1111111111111,3,4,5
Z111111111111,X111111111111,3,4,5
1111411111111,1111111111111,3,4,5
1111111111111,1111111111111,3,4,5
1111111111111,1111111111111,3,4,5
1111111111111,1116111111111,3,4,5

お礼日時：2020/03/09 14:36

No.5 回答者： end-u 回答日時： 2020/03/04 19:22

300万行以上って厳しいだろうなぁ..と思いつ　つ参考コード

Sub try()
　　Dim x
　　x = Application.GetOpenFilename("csv,*.csv,all,*.*")
　　If VarType(x) = vbBoolean Then Exit Sub

　　Dim wkSHT　　As Worksheet
　　Dim wkQRY　　As QueryTable
　　Dim wkCON(2) As String
　　Dim wkSQL(2) As String
　　Dim p　　　　As Long

　　p = InStrRev(x, "\")
　　wkCON(0) = "ODBC"
　　wkCON(1) = "Driver={Microsoft Text Driver (*.txt; *.csv)}"
　　wkCON(2) = "DBQ=" & Left$(x, p)
　　wkSQL(0) = "SELECT * FROM"
　　wkSQL(1) = Mid$(x, p + 1)
　　wkSQL(2) = "WHERE [ID_A]<>[ID_B]"

　　Set wkSHT = Sheets.Add
　　Set wkQRY = wkSHT.QueryTables.Add(Connection:=Join(wkCON, ";"), _
　　　　　　　　　　　　　　　　　　　Destination:=wkSHT.Range("A1"), _
　　　　　　　　　　　　　　　　　　　Sql:=Join(wkSQL))
　　wkQRY.Refresh BackgroundQuery:=False
　　wkQRY.Delete
End Sub

使いものにならない時は捨ててください :)

この回答へのお礼

SQL構文エラーと出まして、結果が得られませんでした。
wkQRY.Refresh BackgroundQuery:=False
直せるスキルがなくてすみません。。

お礼日時：2020/03/05 17:40

No.4 回答者： Qchan1962 回答日時： 2020/03/04 05:59

#2さんのアドバイスに賛成です

どうしてもExcelVBAでなら、結局、Windows Script Host Object Modelを参照してコマンドプロンプトを使う事になると思います。

銀鱗さんのコマンドを拝借すると
Dim cmd As String
　cmd = "for /f " & """tokens=1,2,3,4,5 delims=, """ & " %i in ( souse.csv ) do ( if not %i==%j ( @echo %i,%j,%k,%l,%m >> make.csv ) )"

コマンドプロンプトで実行
　CreateObject("WScript.Shell").Run "CMD.EXE /k " & cmd　'ディレクトリなど不具合確認のため /k　にしてますが　実行時は　/c でよろしいかと

これは、銀鱗さんのコマンドをVBAからコマンドプロンプトで実行しているにすぎません。
つまり、VBAでスタックを気にしながら色々やるより、コマンドプロンプトを使う方が良いと思います。

ディレクトリは、コマンドプロンプトで確認するか、適時変更してください。

コマンドプロンプトからCSVを操作したことがなかったので、銀鱗さんのコマンドは、大変勉強になりました。
（少し変えてしまいましたが、勝手に拝借してすみません）