わんすけに聞いてみる WinActor [WinActor]CSVの差分出力（高速版）

[WinActor]CSVの差分出力（高速版）

2019年10月2日2019年10月2日| yizmyizm| 0件のコメント | 22:55
Categories:

前回のスクリプトで試しに大きめのデータを実行してみたら、エラーこそ出ないもののめっちゃ時間かかった。

1500×1500くらいのガチ二重ループだものね・・・。

ってことで、さっくり高速で終わるバージョンのスクリプトも書いてみました。

 

１．CSV差分出力（高速版）

高速化する為に、ADODB.Connectionっていうの使ってCSVをテーブルとして扱ってSQL実行しています。

前回のスクリプトは端末選びませんが、今回のスクリプトは端末によってはODBCデータソースとかDBドライバーの登録状況によって動かない場合もあるかも。

それでもこっちの方が高速だから、ひとまずこっち試してエラー出た場合だけ前回のスクリプト使うってことでいいかな。

ただ、制約としてこっちのスクリプトの場合は、２つの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件のフィードバック

  1. ピンバック: [VBS]ADODB.Connectionを試してみた。 | 筋トレしようぜ。

コメントを残す

メールアドレスが公開されることはありません。 ※ が付いている欄は必須項目です

Related Post

[WinActor]ブラウザ関連 値を取得して更新して更新ログ残す。[WinActor]ブラウザ関連 値を取得して更新して更新ログ残す。

ブラウザ関連で、設定値の一覧から順番にデータを検索・更新するんだけど システム側の値を更新した時は更新した個所のログが欲しいって場合の話。 普通にサブルーチングループ使って実装せいって話なんだけど ブラウザ関連のライブラ […]

Read MoreRead More

[WinActor]エラー情報収集[WinActor]エラー情報収集

シナリオは、常にエラーが発生する可能性を孕んでます。 シナリオを作って提供すると、必ず 「なんかエラー出て止まっちゃったんですよねー。」 といって声を掛けられることになります。 担当者がエラー対処に慣れてる方じゃない限り […]

Read MoreRead More