Excel

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

2021-07-04

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

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

参考:配列の基本

設定するエクセルシート

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

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

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

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

  • 一番左の番号は同じ
  • 一番左の番号の並び順は同じ
  • データ件数は同じ
テキストファイル
テキストファイルを開いた

パス

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

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

data1 ・ data12

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

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

data1と data12

結果

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

結果

サンプルコード

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

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

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
  • 9~10行:読み込むテキストファイルのパスとファイル名取得
  • 11行:「Call imData」で42行目の「Sub imData」を呼び出します
    このときにファイル名とファイルパスを引数で指定します
  • 14~15行:読み込んだテキストファイルの値を配列に格納します
  • 16~17行:比較結果を格納する配列
  • 22~34行:「data1」と「data2」を比較し、同じなら「data1」のデータを配列「Arry3」に格納します
    配列に格納せずにシート「結果」に書き込む方法の方がわかりやすいかも
  • 36~40行:配列シート「Arry3」を「結果」に書き出します
  • 42~53行:クエリテーブルオブジェクトでテキストファイル「data1」と「data2」をシートへ読み込む

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

シート「結果」に書き出したデータのうち、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

-Excel
-

© 2021 オフィスのQ&A