前回のスクリプトで試しに大きめのデータを実行してみたら、エラーこそ出ないもののめっちゃ時間かかった。
1500×1500くらいのガチ二重ループだものね・・・。
ってことで、さっくり高速で終わるバージョンのスクリプトも書いてみました。
1.CSV差分出力(高速版)
高速化する為に、ADODB.Connectionっていうの使ってCSVをテーブルとして扱ってSQL実行しています。
前回のスクリプトは端末選びませんが、今回のスクリプトは端末によってはODBCデータソースとかDBドライバーの登録状況によって動かない場合もあるかも。
それでもこっちの方が高速だから、ひとまずこっち試してエラー出た場合だけ前回のスクリプト使うってことでいいかな。
ただ、制約としてこっちのスクリプトの場合は、2つのCSVが同じフォルダに配置されていないと動きません。
いつもの如く、スクリプト実行ステージのスクリプトタブに張り付ければすぐに使えるスクリプトです。
Dim BaseFolder, objFS, SrcFN, MtchFN Dim CsvPath, CsvName Dim SrcTxt, lnTXT, ColHeader Dim KeyCols Dim OutPutFile, OutPutStr Set objFS = CreateObject("Scripting.FileSystemObject") SrcFN = !親CSV! MtchFN = !間引くCSV! KeyCols = split(Replace(!判定カラム(カンマ区切り)!, """", ""), ",") OutPutFile = !出力ファイル名! BaseFolder = objFS.GetParentFolderName(SrcFN) If BaseFolder <> objFS.GetParentFolderName(MtchFN) Then Err.Raise 501, "", "2つのCSVは同じフォルダに配置して下さい。" WScript.Quit End If For Each CsvName In Array(SrcFN, MtchFN) If Not objFS.FileExists(CsvName) Then Err.Raise 404, "", "「" & CsvName & "」ファイルが見つかりません。" WScript.Quit End If Next SrcTxt = Read_TEXT(SrcFN) lnTXT = split(SrcTxt, vbCrLf) ColHeader = splitEx(lnTXT(0), NULL, NULL, NULL) SrcFN = objFS.GetFileName(SrcFN) MtchFN = objFS.GetFileName(MtchFN) Set objFS = Nothing ColSQL = "" For i=0 To UBound(ColHeader) If Len(ColSQL) > 0 Then ColSQL = ColSQL & ", " ColSQL = ColSQL & "[t1." & ColHeader(i) & "]" Next PartSQL = "" For i=0 To UBound(KeyCols) If Len(PartSQL) > 0 Then PartSQL = PartSQL & " AND " PartSQL = PartSQL & "t1." & KeyCols(i) & " = t2." & KeyCols(i) Next PartSQL = PartSQL & ") where t2." & KeyCols(0) & " is null" strSQL = "SELECT " & ColSQL & " FROM [" & SrcFN & "] as t1 left join [" & MtchFN & "] AS t2 on (" & PartSQL Set aq = New QueryADO Set rec = aq.GetRecordFromCSV(BaseFolder, strSQL) For Each fld In rec.Fields OutPutStr = OutPutStr & fld.Name & "," Next OutPutStr = OutPutStr & vbNewLine Do While Not rec.EOF lnStr = "" For Each fld In rec.Fields If Len(lnStr) > 0 Then lnStr = lnStr & "," lnStr = lnStr & rec(fld.Name).Value Next OutPutStr = OutPutStr & lnStr & vbNewLine rec.MoveNext Loop Set aq = Nothing Write_TEXT OutPutStr, OutPutFile WScript.Quit ' ADOでCSVにSQL発行 Class QueryADO Private objADO Private objRS Public Sub Class_Initialize Set objADO = CreateObject("ADODB.Connection") End Sub Public Sub Class_Terminate On Error Resume Next objRS.Close Set objRs = Nothing objADO.Close Set objADO = Nothing On Error GoTo 0 End Sub Function GetRecordFromCSV(BaseFolder, pSQL) objADO.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};DBQ=" & BaseFolder & ";ReadOnly=1" Set GetRecordFromCSV = objADO.Execute(pSQL) End Function End Class '■ メイン処理ここまで ■ 以下、呼び出し関数 ■ Function Read_TEXT(FilePath) Dim objFS, objTXT, Rslt Set objFS = CreateObject("Scripting.FileSystemObject") If objFS.FileExists(FilePath) Then Set objTXT = objFS.OpenTextFile(FilePath, 1) Rslt = objTXT.ReadAll() objTXT.close Set objTXT = Nothing Else Rslt = "" End If Set objFS = Nothing Read_TEXT = Rslt End Function Function Write_TEXT(ContentStr, FilePath) Dim objFS, objTXT On Error Resume Next Set objFS = CreateObject("Scripting.FileSystemObject") Set objTXT = objFS.OpenTextFile(FilePath, 2, True) objTXT.Write ContentStr objTXT.close Set objTXT = Nothing Set objFS = Nothing If Err.Number > 0 Then Write_TEXT = False Err.Clear Else Write_TEXT = True End If End Function ' 引用: http://blog.livedoor.jp/tea_cocoa_cake/archives/5356742.html '! Split()のテキスト区切り対応版 '! テキスト区切り文字(例CSVの")に対応した区切りを行う '! @param source 元文字列 '! @param colDelim 列区切り文字(NULL可、NULLの場合「,」使用) '! @param lineDelim 行区切り文字(NULL可、NULLの場合vbCrLfを使用) '! @param textDelim テキスト区切り文字(NULL可、NULLの場合「"」を使用) (textDelim2つでテキスト区切り文字エスケープ) '! @return 1次元配列 (改行がある場合は配列要素としてvbNullChar単体が格納される public function splitEx(source, colDelim, lineDelim, textDelim) splitEx = NULL dim textMode: textMode = False if (isNull(colDelim) ) Then colDelim = "," end if if (isNull(lineDelim) ) Then lineDelim = vbCrLf end if if (isNull(textDelim) ) Then textDelim = """" end if dim ab : set ab = New ArrayBuilder dim textBuf : textBuf = "" ' テキストバッファ dim char_i : char_i = 1 ' 文字列のインデックス Do while (char_i <= len(source)) dim curChar : curChar = getChar(source, char_i) if(textMode = True) Then select case curChar case textDelim '! 1文字先読み And エスケープ判定 if ( getChar(source, char_i + 1) = textDelim ) Then ' エスケープ textBuf = textBuf & getChar(source, char_i + 1) char_i = char_i + 1 ' 先読み分カウンタを加算 else ' テキストモードOFF textMode = False end if case Else textBuf = textBuf & curChar end select else select case curChar case colDelim ab.add textBuf textBuf = "" case lineDelim ab.add textBuf ab.add vbNullChar ' 改行を示す textBuf = "" case vbCr '! 1文字先読み And lineDelim=vbCrLf(※2文字)の場合の特殊な判定 if ( getChar(source, char_i + 1) = vbLf And lineDelim = vbCrLf ) Then ab.add textBuf ab.add vbNullChar ' 改行を示す textBuf = "" char_i = char_i + 1 ' 先読み分カウンタを加算 else textBuf = textBuf & curChar end if case textDelim ' テキストモードON textMode = True case Else textBuf = textBuf & curChar end select end if char_i = char_i + 1 loop ' 最後にテキストバッファの残りを処理 ab.add textBuf splitEx = ab.toArray() end function '! 文字列から1文字取得。文字列終端(VBScripでは通常参照しない)の場合ではvbNullChar(00)を返す '! @param source 元文字列 '! @param index 文字列のインデックス '! @return 文字 private function getChar(source, index) getChar = "" if (index <= 0 Or index > (len(source) + 1) ) Then err.raise 1025,,"範囲外の参照" exit function end if ' 文字列終端の場合 if (index = (len(source) + 1) ) Then getChar = vbNullChar end if getChar = mid(source, index, 1) end function '! 配列生成 class ArrayBuilder private my_lastIndex private my_array() Public Sub Class_Initialize dim INITIAL_SIZE : INITIAL_SIZE = 8 my_lastIndex = -1 redim Preserve my_array(INITIAL_SIZE - 1) ' 注意...配列は(指定サイズ + 1)のサイズで領域が確保される End Sub Public Sub Class_Terminate End Sub '! 値の参照 '! @param index 配列インデックス '! @return 値 public property get item(index) if (index < 0 Or index > my_lastIndex) Then err.raise 1025,,"範囲外の参照" exit property end if item = my_array(index) end property '! 値のセット '! @param index 配列インデックス '! @param value 値 public property let item(index, value) if (index < 0) Then err.raise 1025,,"範囲外の参照" exit property end if ' Expand Do While (index >= getSize() ) call expand() Loop if (index > my_lastIndex) Then my_lastIndex = index end if my_array(index) = value end property '! 最後尾に値の追加 '! @param value 値 public sub add(value) me.item(my_lastIndex + 1) = value end sub '! 配列拡張 private sub expand() '+ wscript.echo "#Expanded!" ' 再確保のオーバヘッド軽減のため大きめにサイズを拡張 redim Preserve my_array(getSize() * 2 - 1) end sub '! 配列サイズ取得 '! @return 現在の配列サイズ private function getSize() '+ wscript.echo "#size:" & UBound(my_array) - LBound(my_array) + 1 getSize = UBound(my_array) - LBound(my_array) + 1 end function '! 要素に合わせて配列サイズを縮小 '! @param arr 配列 '! @return 縮小後の配列 private function fit(ByRef arr) redim Preserve arr(my_lastIndex) fit = arr end function '! 配列を返す '! @return 配列 public function toArray() dim tmpArray : tmpArray = my_array tmpArray = fit(tmpArray) toArray = tmpArray end function end class
使い方のイメージは前回の記事を参照して下さい。
ADODB.Connection使うと、ExcelのシートにもSQL実行できるみたいですねぃ。
使ったことないから今度試してみよ。
「[WinActor]CSVの差分出力(高速版)」への1件のフィードバック