質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

87.37%

vbs ファイルの差分比較

解決済

回答 4

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 4,237

score 10

【質問内容】
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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • Y.H.

    2019/10/11 09:58

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

    キャンセル

  • hj_zebra

    2019/10/11 10:57

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

    キャンセル

  • hj_zebra

    2019/10/11 10:59

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

    キャンセル

回答 4

checkベストアンサー

+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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/10/11 11:44

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

    キャンセル

  • 2019/10/11 11:55

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

    キャンセル

  • 2019/10/11 11:59

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

    キャンセル

  • 2019/10/11 13:03 編集

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

    キャンセル

+1

時刻の比較と、社員番号・日付ごとに取得する処理を考えた時に
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
    ' ファイル1
    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
    ' ファイル2
    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型にします
一番時刻の遅い値を取得する時に必要な知識だと思うのでご確認ください。

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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/10/11 13:05

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

    キャンセル

+1

内側のループでファイル(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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/10/11 13:04 編集

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

    キャンセル

+1

単純に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


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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/10/11 13:03

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 87.37%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る