2つのテキストファイルを比較し不一致個所をシートに書き出す

テキストファイルをエクセルのシートに読み込み、2つのシートの不一致を探す方法です。

「エクセルのクエリテーブルオブジェクトで複数のテキストファイルを読み込む 」の続きです。

参考：配列の基本 

設定するエクセルシート

3つのシートを用意します。

• パス：読み込むパスを入力するシート
• data1：テキストファイル「data1」を読み込むシート
• data2：テキストファイル「data2」を読み込むシート
• 結果：シート「data1」と「data2」の不一致を書き込むシート

読み込むテキストファイル

2つのテキストファイルの条件

• 一番左の番号は同じ
• 一番左の番号の並び順は同じ
• データ件数は同じ

パス

読込むファイルを設定するシートです。

• A列：書き込み先のシート名
• B列：テキストファイルの保存先

data1 ・ data12

テキストファイルの読み込み先です。

「data2」 の緑枠は 「data1」との不一致個所です。

結果

「data1」 と 「data2」 を比較した結果を書き出すシートです。

サンプルコード

いくつかある方法のうちの２つです。

比較データを配列に格納する

Sub sample1()
    Dim wsP As Worksheet: Set wsP = Worksheets("パス")
    Dim ws1 As Worksheet: Set ws1 = Worksheets("data1")
    Dim ws2 As Worksheet: Set ws2 = Worksheets("data2")
    Dim wsK As Worksheet: Set wsK = Worksheets("結果")
    
    Dim i As Long
    For i = 1 To 2
        Dim fName As String: fName = wsP.Cells(i, 1)
        Dim dPath As String: dPath = wsP.Cells(i, 2)
        Call imData(fName, dPath)
    Next i
    
    Dim Arry1 As Variant: Arry1 = ws1.Range("A1").CurrentRegion
    Dim Arry2 As Variant: Arry2 = ws2.Range("A1").CurrentRegion
    
    wsK.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Dim r As Long, c As Long, fCnt As Long
    
    fCnt = 0
    For r = 2 To UBound(Arry1)
        For c = LBound(Arry1, 2) To UBound(Arry1, 2)
            If Arry1(r, c) = Arry2(r, c) Then
                    wsK.Cells(r, c) = Arry1(r, c)
               Else
                    wsK.Cells(r, c) = "不一致"
                    fCnt = fCnt + 1
            End If
        Next c
         wsK.Cells(r, 5) = fCnt
         fCnt = 0
    Next r
End Sub
Private Sub imData(ByVal fName As String, ByVal dPath As String)
   Worksheets(fName).Range("A1").CurrentRegion.ClearContents
    Dim imData As QueryTable
    Set imData = Worksheets(fName).QueryTables.Add(Connection:="TEXT;" & dPath, _
                    Destination:=Worksheets(fName).Range("A1"))
    With imData
        .TextFilePlatform = 65001
        .TextFileParseType = xlFixedWidth
        .TextFileFixedColumnWidths = Array(8, 12, 12, 12)
        .Refresh
        .Delete
    End With
End Sub

比較結果も配列に格納する

Sub sample2()
    Dim wsP As Worksheet: Set wsP = Worksheets("パス")
    Dim ws1 As Worksheet: Set ws1 = Worksheets("data1")
    Dim ws2 As Worksheet: Set ws2 = Worksheets("data2")
    Dim wsK As Worksheet: Set wsK = Worksheets("結果")
    
    Dim i As Long
    For i = 1 To 2
        Dim fName As String: fName = wsP.Cells(i, 1)
        Dim dPath As String: dPath = wsP.Cells(i, 2)
        Call imData(fName, dPath)
    Next i
    
    Dim Arry1 As Variant: Arry1 = ws1.Range("A1").CurrentRegion
    Dim Arry2 As Variant: Arry2 = ws2.Range("A1").CurrentRegion
    Dim Arry3() As Variant
    ReDim Arry3(1 To UBound(Arry1), 1 To UBound(Arry1, 2) + 1)
    
    wsK.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Dim r As Long, c As Long, fCnt As Long
    
    fCnt = 0
    For r = 2 To UBound(Arry1)
        For c = LBound(Arry1, 2) To UBound(Arry1, 2)
            If Arry1(r, c) = Arry2(r, c) Then
                    Arry3(r, c) = Arry1(r, c)
               Else
                    Arry3(r, c) = "不一致"
                    fCnt = fCnt + 1
            End If
        Next c
         Arry3(r, 5) = fCnt
         fCnt = 0
    Next r
    
    For r = 2 To UBound(Arry1)
        For c = LBound(Arry1, 2) To UBound(Arry1, 2) + 1
                    wsK.Cells(r, c) = Arry3(r, c)
        Next c
    Next r
End Sub
Private Sub imData(ByVal fName As String, ByVal dPath As String)
   Worksheets(fName).Range("A1").CurrentRegion.ClearContents
    Dim imData As QueryTable
    Set imData = Worksheets(fName).QueryTables.Add(Connection:="TEXT;" & dPath, _
                    Destination:=Worksheets(fName).Range("A1"))
    With imData
        .TextFilePlatform = 65001
        .TextFileParseType = xlFixedWidth
        .TextFileFixedColumnWidths = Array(8, 12, 12, 12)
        .Refresh
        .Delete
    End With
End Sub

不一致データの番号を抜き出す

シート「結果」に書き出したデータのうち、A列のデータのみシート「パス」のセルA4へ書き出す場合の処理です。

29行目の下に追記します。

 　With wsK.Range("A1")
        .AutoFilter Field:=5, Criteria1:=">0"
        .CurrentRegion.Resize(, 1).Copy wsP.Range("A4")
         wsK.Range("A1").AutoFilter
    End With