vbs ファイルの差分比較

Question

【質問内容】
test1.csvの社員番号と日付とtest2.csvの番号と日付が一致した時だけ
test1.csvの時刻とtest2.csvの3つの時刻の中で（計4つ）の中で一番時刻の遅い値を返すプログラムを書こうとしています。
test2.csvにデータがなかった場合はそのままtest.1の内容を出力したいです。

for文などを使用して添え字やキーなどを作れば可能になりますでしょうか。
ご教示ください。

###テストデータ

**テストファイル1：test1.csvの内容**
12345,2019/01/01,17:25
12345,2019/01/02,19:25
12345,2019/01/03,21:25
12345,2019/01/04,23:25

**テストファイル2：test2.csvの内容**
12345,2019/01/01,17:25,23:25,19:25
12345,2019/01/02,19:25,20:25,21:25
12345,2019/01/03,21:25,19:25,15:25
12345,2019/01/04,23:25,21:25,21:25

**出力したい内容：OutFile1.csv**
12345,2019/01/01,23:25
12345,2019/01/02,21:25
12345,2019/01/03,21:25
12345,2019/01/04,23:25

発生している問題・エラーメッセージ

内側のDo Until objInFile2.AtEndOfStreamが終わったあと
test1.csvの2行目を比較したいのですが、書き込み処理に移ってしまいます。

■現在出力される内容
12345,2019/01/01,23:25
12345,2019/01/02,19:25
12345,2019/01/03,21:25
12345,2019/01/04,23:25

###　作成を試みたソース

Const Path = "C:"
Const InFile1 = "test1.csv" 
Const InFile2 = "test2.csv"
Const OutFile1 = "OutFile1.csv"


Dim objFso
Dim T_KEY
Dim SYA_BG
Dim KINMU_DATE
Dim TIME_1_1

Dim M_KEY
Dim SYA_BG2
Dim KINMU_DATE2
Dim TIME2_1
Dim TIME2_2
Dim TIME2_3


Dim count1
Dim count2
Dim NUM(4)
Dim NUM_MAX

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objInFile = objFso.OpenTextFile(Path & "\" & InFile1, 1, False)
Set objInFile2 = objFso.OpenTextFile(Path & "\" & InFile2, 1, False)
Set objOutFile = objFso.OpenTextFile(Path & "\" & OutFile1, 2, True)
Do Until objInFile.AtEndOfStream
	strInFileLine = Split(objInFile.ReadLine, ",")
	SYA_BG = strInFileLine(0)
	KINMU_DATE = strInFileLine(1)
	TIME_1_1 = strInFileLine(2)
	Do Until objInFile2.AtEndOfStream
		strInFileLine2 = Split(objInFile2.ReadLine, ",")
		SYA_BG2 = strInFileLine2(0)
		KINMU_DATE2 = strInFileLine2(1)
		NUM(1) = TIME_1_1
		NUM(2) = strInFileLine2(2)
		NUM(3) = strInFileLine2(3)
		NUM(4) = strInFileLine2(4)
		IF SYA_BG = SYA_BG2 AND KINMU_DATE = KINMU_DATE2 Then
			for i = 1 to 4
				if NUM_MAX < NUM(i) Then
					NUM_MAX = NUM(i)
				END IF
			NEXT
		END IF
		TIME_1_1 = NUM_MAX		
	Loop
	objOutFile.WriteLine SYA_BG & "," & KINMU_DATE  & "," & TIME_1_1 
Loop
objInfile.Close
objInfile2.Close
objOutfile.Close
Set objInfile = Nothing
Set objInfile2 = Nothing
Set objOutFile1 = Nothing

Set objfso = Nothing

使用言語

VBS

Comments

[Youbun]

https://teratail.com/help#about-template
このサイトの「対応しているMarkdownの記法を知りたい」項目をみて
ソースコードを貼り付けてください。
また、ソースコードのインデントもきっちりしてくれると
ソースコードが見やすくなって良い感じになると思います。

[YAmaGNZ]

内側のループの中にobjOutFile.WriteLineがあるので、内側のループで出力するのはあたりまえなのでは？

[Y.H.]

> 書き込み処理に移ってしまいます
「書き込み処理」とは提示のソースのどの部分（行）でしょうか？
質問に記載ください。

[Y.H.]

タグに[java]がありますが、どのように関係するのでしょうか？質問に記載ください。
もし関係しないのであれば削除ください。

[hj_zebra]

>YAmaGNZさん
回答ありがとうございます。
外側にしたところ出力したい内容に近づきました

[hj_zebra]

>Y.H.さん
書き込み処理についてはobjOutFile.WriteLine SYA_BG & "," & KINMU_DATE & "," & TIME_1_1 になります。
不必要なタグは削除いたしました。

Answer 1

条件に一致して処理したあと、内側のループを抜けていないからではないでしょうか。
If文の最後でExit Doすればよろしいかと。
それとobjInFile2が継続して処理されてしまうので、外側のループの最初でオープン、終了でクローズしたほうがよいでしょう。
本来なら開きっぱなしでファイルポインタだけ先頭に移動できればよいのですが、TextStreamでやる方法がわかりませんでした。
以上のことを考慮して修正したコードです。
修正したところは★でコメント入れてあります。
動作未確認ですので何かあればコメントください。

Const Path = "C:"
Const InFile1 = "test1.csv" 
Const InFile2 = "test2.csv"
Const OutFile1 = "OutFile1.csv"


Dim objFso
Dim T_KEY
Dim SYA_BG
Dim KINMU_DATE
Dim TIME_1_1

Dim M_KEY
Dim SYA_BG2
Dim KINMU_DATE2
Dim TIME2_1
Dim TIME2_2
Dim TIME2_3


Dim count1
Dim count2
Dim NUM(4)
Dim NUM_MAX

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objInFile = objFso.OpenTextFile(Path & "\" & InFile1, 1, False)
Set objOutFile = objFso.OpenTextFile(Path & "\" & OutFile1, 2, True)
Do Until objInFile.AtEndOfStream
    strInFileLine = Split(objInFile.ReadLine, ",")
    SYA_BG = strInFileLine(0)
    KINMU_DATE = strInFileLine(1)
    TIME_1_1 = strInFileLine(2)
    NUM_MAX = TIME_1_1                                         ' ★追加
	Set objInFile2 = objFso.OpenTextFile(Path & "\" & InFile2, 1, False)	' ★ここに移動
    Do Until objInFile2.AtEndOfStream
        strInFileLine2 = Split(objInFile2.ReadLine, ",")
        SYA_BG2 = strInFileLine2(0)
        KINMU_DATE2 = strInFileLine2(1)
        IF SYA_BG = SYA_BG2 AND KINMU_DATE = KINMU_DATE2 Then
            for i = 2 to 4                                      ' ★2からに変更
                if NUM_MAX < strInFileLine2(i) Then             ' ★配列を直接参照
                    NUM_MAX = strInFileLine2(i)
                END IF
            NEXT
			Exit Do					' ★追加
        END IF
        'TIME_1_1 = NUM_MAX        ' ★これは不要
    Loop
	objInfile2.Close				' ★追加
'   objOutFile.WriteLine SYA_BG & "," & KINMU_DATE  & "," & TIME_1_1    ' ★削除して
    objOutFile.WriteLine SYA_BG & "," & KINMU_DATE  & "," & NUM_MAX     ' ★これに変更
Loop
objInfile.Close
objOutfile.Close
Set objInfile = Nothing
Set objInfile2 = Nothing
Set objOutFile1 = Nothing

Set objfso = Nothing

Comments

[YAmaGNZ]

objOutFile.WriteLine SYA_BG & "," & KINMU_DATE & "," & NUM_MAX
なら分かりますが、不要と削除した
TIME_1_1 = NUM_MAX
がないと、せっかく求めた一番遅い時間が更新されないのではないですか？

[ttyp03]

あ、ホントだ。
見落としてました。
なんで折角求めたNUM_MAXを使わないで、TIME_1_1を使ってるんだ･･･。
指摘ありがとうございます。
あとで修正しておきます。

[ttyp03]

というか、NUM_MAXの初期化もありませんね。

[hj_zebra]

>ttyp03さん
とても分かりやすく回答していただきありがとうございました。
おかげで解決できました。

Answer 2

単純にtest2.csvのほうが1回目のループで最後まで読み込まれ、次の外側のループでまったく処理されていないのが原因かと思います。

    Set objInFile2 = objFso.OpenTextFile(Path & "\" & InFile2, 1, False)
    Do Until objInFile2.AtEndOfStream
        '処理
    Loop
    objInFile2.Close

とループごとに閉じて最初から読み込むようにすればよろしいかと思います。

最終時刻を求める際に

Do Until objInFile.AtEndOfStream
    strInFileLine = Split(objInFile.ReadLine, ",")
    SYA_BG = strInFileLine(0)
    KINMU_DATE = strInFileLine(1)

    NUM_MAX = strInFileLine(2)    '比較対象として初期化

    Set objInFile2 = objFso.OpenTextFile(Path & "\" & InFile2, 1, False)
    Do Until objInFile2.AtEndOfStream
        strInFileLine2 = Split(objInFile2.ReadLine, ",")
        SYA_BG2 = strInFileLine2(0)
        KINMU_DATE2 = strInFileLine2(1)
        NUM(1) = strInFileLine2(2)
        NUM(2) = strInFileLine2(3)
        NUM(3) = strInFileLine2(4)
        IF SYA_BG = SYA_BG2 AND KINMU_DATE = KINMU_DATE2 Then
            for i = 1 to 3
                if NUM_MAX < NUM(i) Then
                    NUM_MAX = NUM(i)
                END IF
            NEXT
        END IF
        'TIME_1_1 = NUM_MAX   '不要     
    Loop
    objInFile2.Close
    objOutFile.WriteLine SYA_BG & "," & KINMU_DATE  & "," & NUM_MAX
Loop

と比較対象の初期化を行うほうがよろしいかと思います。

Comments

[hj_zebra]

>YAmaGNZさん
とても分かりやすく回答していただきありがとうございました。
おかげで解決できました。

Answer 3

内側のループでファイル(test2.csv)をAtEndOfStreamまで読んでいますが
これによりFSO内部の読み込みポインタがファイル終端になっていますので
2回目は読み込めません。以降内側のAtEndOfStreamは常にTrueとなります。

このためobjInFile(外側)の1ループ目はうまくいきますが、2ループ目
以降は内側のAtEndOfStreamが最初からTrueとなり内側のループには入
りません。

対策としては、以下が考えられます。
(a) test2.csvを毎回オープン/クローズする。
(b) test2.csv全体をStringに保存し、毎回そこから切り出す
(c) CSVファイルをExcelテーブルに読み込むんで処理

…オススメは(c)かな。

  Dim WB1 As Workbook: Set WB1 = Workbooks.Open("C:\test1.csv")          ' test1をExcelに読み込む
  Dim SH1 As Worksheet: Set SH1 = WB1.Sheets(1)                                   ' test1のシート
  Dim WB2 As Workbook: Set WB2 = Workbooks.Open("C:\test2.csv")          ' test2をExcelに読み込む
  Dim SH2 As Worksheet: Set SH2 = WB2.Sheets(1)                                   ' test2のシート
  '
  ' SH1(test1)を書き換えていく
  '
  Dim rx1 As Long: rx1 = 1                                                        ' test1の行インデクス
  Do While (SH1.Cells(rx1, "A") <> "")                                            ' test1の終端まで
    Dim rx2 As Long: rx2 = 1                                                      ' test2の行インデクス
    Do While (SH2.Cells(rx2, "A") <> "")                                          ' test2の終端まで
      If (SH2.Cells(rx2, "A") = SH1.Cells(rx1, "A")) Then                         ' 番号が一致
        If (SH2.Cells(rx2, "B") = SH1.Cells(rx1, "B")) Then                       ' 日付が一致
          SH1.Cells(rx1, "C") = Application.WorksheetFunction.Max(SH1.Cells(rx1, "C"), SH2.Cells(rx2, "C").Resize(1, 3))
          Exit Do
        End If
      End If
      rx2 = rx2 + 1
    Loop
    rx1 = rx1 + 1                                                               ' インデクスを進める
  Loop
  '
  ' SH1をコピーして出力ファイルとする。SH1(test1)は保存しないのでもとのまま
  '
  SH1.Copy                                                                        ' test1をコピーしてworkのbookを作る
  Dim WBO As Workbook: Set WBO = ActiveWorkbook
  Call WBO.SaveAs("C:\OutFile1.csv", xlCSV)                               ' workのBookをCSVで保存
  Call WBO.Close(False, , False)
  Call WB1.Close(False, , False)                                                  ' test1:保存しない
  Call WB2.Close(False, , False)                                                  ' test2:保存しない

  Set SH1 = Nothing
  Set SH2 = Nothing

  Set WB1 = Nothing
  Set WB2 = Nothing
  Set WBO = Nothing

Comments

[hj_zebra]

>h.horikoshiさん
対策方法などを複数提案していただきありがとうございました。
もっと勉強しようと思います。
おかげで解決できました。

Answer 4

時刻の比較と、社員番号・日付ごとに取得する処理を考えた時に
naokiさんのコードを変更しようとすると
物凄くめんどくさかったので一から書き直しました。

デバッグで使用したテストファイルと出力したマージ後ファイルの内容

◆ test1.csv
123450,2019/01/01,11:25
123451,2019/01/02,10:25
123452,2019/01/03,05:25
123453,2019/01/04,13:25
◆ test2.csv
123450,2019/01/01,17:25,23:25,19:25
123453,2019/01/01,03:25,21:25,21:25
123451,2019/01/02,19:25,20:25,21:25
123450,2019/01/02,17:25,23:25,19:25
123452,2019/01/03,21:25,19:25,15:25
123450,2019/01/03,12:25,23:25,19:25
123452,2019/01/04,21:25,10:25,15:25
123453,2019/01/04,23:25,21:25,21:25
◆ OutFile.csv
123450,2019/01/01,23:25
123451,2019/01/02,21:25
123452,2019/01/03,21:25
123453,2019/01/04,23:25
123453,2019/01/01,21:25
123450,2019/01/02,23:25
123450,2019/01/03,23:25
123452,2019/01/04,21:25

作成したソースコード

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' 関数：メインルーチン
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
Sub MR_MargeCsvFile()
    ' CSVファイルを変数に取得
    Dim path As String
    Dim file1() As String
    Dim file2() As String
    path = ThisWorkbook.path
    file1 = GetFileData_Txt(path + "\test1.csv")
    file2 = GetFileData_Txt(path + "\test2.csv")
    
    ' 社員番号+日時ごとに時刻をマージ
    Dim dic_marge As Object
    Set dic_marge = VBA.CreateObject("Scripting.Dictionary")
    Dim i_yoso, i_yosoc As Integer
    Dim keyset As String
    Dim splitval() As String
    ' ファイル１
    For i_yoso = 0 To UBound(file1)
        splitval = split(file1(i_yoso), ",")
        keyset = splitval(0) + "," + splitval(1)
        dic_marge.Add keyset, CDate(splitval(2))
    Next
    ' ファイル２
    For i_yoso = 0 To UBound(file2)
        splitval = split(file2(i_yoso), ",")
        keyset = splitval(0) + "," + splitval(1)
        For i_yosoc = 2 To 4
            If dic_marge.Exists(keyset) Then
                If dic_marge.Item(keyset) < CDate(splitval(i_yosoc)) Then
                    dic_marge.Item(keyset) = CDate(splitval(i_yosoc))
                End If
            Else
                dic_marge.Add keyset, CDate(splitval(i_yosoc))
            End If
        Next
    Next
    
    ' マージ後の変数をファイルに出力
    Dim outvalue As String
    outvalue = ""
    For Each keyone In dic_marge
        If outvalue <> "" Then
            outvalue = outvalue + vbCrLf
        End If
        outvalue = outvalue + keyone + ","
        outvalue = outvalue + Format(dic_marge.Item(keyone), "hh:nn")
    Next
    Call OutFileData("OutFile1.csv", outvalue)
End Sub

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' 関数：Textファイル読み込み
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
Public Function GetFileData_Txt(str_Pass As String) As String()
    Dim str_buf As String
    Dim fso_GetFile As Object
    Dim fso_GetFileTxt As Object
    ' ファイル存在判定
    If Dir(str_Pass) = "" Then
        ReDim GetFileData_Txt(0)
        Exit Function
    End If
    ' ファイルから変数に格納
    Set fso_GetFile = CreateObject("Scripting.FileSystemObject")
    Set fso_GetFileTxt = fso_GetFile.OpenTextFile(str_Pass)
    str_buf = fso_GetFileTxt.ReadAll
    Set TextFile = Nothing
    Set fso = Nothing
    ' 戻り値設定
    GetFileData_Txt = split(str_buf, vbCrLf)
End Function

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' 関数：ファイル出力
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
Public Sub OutFileData(st_filename As String, st_outdata As String)
    ' 出力パス設定　※このブックと同階層に出力する仕様になってるのでそちらで変更してください
    Dim st_getpass As String
    st_getpass = ThisWorkbook.path + "\" + st_filename
    ' ファイルが存在してたら消す
    If Dir(st_getpass) <> "" Then
        Kill st_getpass
    End If
    ' ファイル出力
    Open st_getpass For Output As #1
    Print #1, st_outdata;
    Close #1
End Sub

自分勝手に一から書いてすみません！
質問に対応している部分のみ説明しますので
自作したソースに自分で考えて、付け加えてみると勉強になると思います！

Dictionaryオブジェクトの説明
上記サイトを見ていただけると分かると思いますが、このDictionaryオブジェクトは
**「test1.csvの社員番号と日付とtest2.csvの番号と日付一致判定」**に便利です。
今回は、Dictionaryオブジェクトのキーに「社員番号と日付」をいれてます

日付文字列を比較・計算する方法
時刻が文字列のままだと比較ができないので、「CDate("時刻")」関数でDate型にします
一番時刻の遅い値を取得する時に必要な知識だと思うのでご確認ください。

他に説明がいることがあったら教えていただければ極力お答えします。

Comments

[hj_zebra]

>Youbunさん
とても分かりやすく回答していただきありがとうございました。
もっと勉強してみようと思います。
おかげで解決できました。