データ突き合わせ 不一致を別ブックに抽出

Question

前提・実現したいこと

同じフォーマットで、２種類のエクセルファイルがあるのですが、
こちらを突き合わせを行い、重複していない行を、
別のブックに抽出を行いたいです。

素人なので、質問の内容が伝わりにくいかもしれませんが、
よろしくお願いいたします。

データ１に

データ２の内容を突き合わせ

不一致を別ブックに抽出

皆様、よろしくお願いいたします。

試したこと

様々なサイトをみましたが、同じようなものがありませんでした

Answer 1

様々なサイトをみましたが、同じようなものがありませんでした

探せばあると思いますが、
ぱっと思いついたところで。。。
多分こういうやり方はどこにも書いてないので、
参考にならないかも知れませんが、
Excelを自動で操作するとこんな感じということで。
逆に言うとこの手順でやれば、手動でやっても出来るということですが。。。

Sub test()
    Dim rngList As Range        '元となる一覧のセル範囲
    Dim rngNew As Range         '抽出したデータのセル範囲
    Dim rngOld As Range         '与えられたデータのセル範囲
    Dim rngResult As Range      '結果表示のセル範囲
    Dim i As Long               '抽出したデータ数

    Set rngList = Workbooks("データ2").Worksheets(1).Range("A1").CurrentRegion
    Set rngNew = rngList(rngList.Rows.Count + 1, 1)
    With Workbooks("データ1").Worksheets(1).Range("A1").CurrentRegion
        Set rngOld = Intersect(.Cells, .Offset(1))
    End With
    Set rngResult = ThisWorkbook.Worksheets(3).Range("A1")

    rngOld.Copy rngNew
    rngNew.CurrentRegion.RemoveDuplicates Header:=xlYes
    i = rngNew.Row
    
    '元と行数が増えたか数えてみる
    With rngList
        i = .CurrentRegion.Rows.Count - .Rows.Count
    End With
    
    '増えていたら転記
    If i > 0 Then
        With rngResult
            rngList.Rows(1).Copy .Range("A1")
            rngNew.Resize(i).Cut .Range("A2")
        End With
    End If
    
    'ブックへの編集が無かったことにする
    rngNew.Worksheet.Parent.Saved = True
End Sub

Answer 2

ベタですが、ループで一つずつ突き合わせてみました。
配列にいれて処理してますので、速度的にも問題ないかな。

Sub Test()
    Dim data1(), data2(), Output(), r As Long, c As Long, r2 As Long, r3 As Long
    Dim d1
    data1 = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
    data2 = Worksheets("Sheet2").Range("A1").CurrentRegion.Value
    ReDim Output(1 To UBound(data1), 1 To UBound(data1, 2))

    For c = 1 To UBound(data1, 2)
        Output(1, c) = data1(1, c)
        r3 = 1
        For r = 2 To UBound(data1)
            d1 = data1(r, c)
            For r2 = 2 To UBound(data2)
                If d1 = data2(r2, c) Then
                    d1 = Null
                    Exit For
                End If
            Next
            If Not IsNull(d1) Then
                r3 = r3 + 1
                Output(r3, c) = d1
            End If
        Next
    Next
    Worksheets("Sheet3").Range("A1:D3").Value = Output
End Sub

データ1 が Sheet1、データ2 が Sheet2、出力先が Sheet3 としてますので、
実際のワークブック、シートに変更してください。

Answer 3

同じような質問があったので参考まで
VBAを使い、表よりデータを抽出して重複を削除したい

Comments

[yoshin1192]

ありがとうございます。
ただ、各行の内容を突き合わせし、別ブックに抽出したいので、
こちら、機会がありましたら参考にさせていただきます。
ご助言、ありがとうございました。