Excel VBA comparing two workbooks

问题

I'm trying to create a macro which compares two Excel files. The only column both Excel files have in common is "eRequest ID". The goal is to display any records that DO NOT have an "eRequest ID" in both files.

For example, if record 1 is only found in one of the two files, it has to be displayed. The only situation where records are not displayed is if the "eRequest ID" is found in both files.

On a side note.. I recorded a simple macro to filter out some fields... I have to add in this part into the final macro as well.

ActiveSheet.ListObjects("Table_JULY15Release_Master_Inventory__2").Range. _
    AutoFilter Field:=2, Criteria1:=Array("90 BIZ - Deferred", _
    "91 GTO - Deferred", "92 BIZ - Dropped", "94 GTO - Duplicate"), Operator:= _
    xlFilterValues
ActiveSheet.ListObjects("Table_JULY15Release_Master_Inventory__2").Range. _
    AutoFilter Field:=4, Criteria1:="Core Banking"

回答1:

Assumes source workbooks are open and listobjects are on the first sheet. Adjust workbook names and sheet indexes/names to suit:

Sub Tester()
Dim lst1 As ListObject, lst2 As ListObject
Dim c1 As ListColumn, c2 As ListColumn
Dim rngDest As Range

    Set lst1 = Workbooks("WkBk A.xlsx").Sheets(1).ListObjects(1)
    Set lst2 = Workbooks("WkBk B.xlsx").Sheets(1).ListObjects(1)

    Set c1 = lst1.ListColumns("eRequest ID")
    Set c2 = lst2.ListColumns("eRequest ID")

    Set rngDest = ThisWorkbook.Sheets(1).Range("A2")

    CopyIfNotMatched c1, c2, rngDest
    CopyIfNotMatched c2, c1, rngDest

End Sub

Sub CopyIfNotMatched(c1 As ListColumn, c2 As ListColumn, rngDest As Range)
    Dim c As Range, f As Range

    For Each c In c1.DataBodyRange.Cells
        Set f = c2.DataBodyRange.Find(c.Value, , xlValues, xlWhole)
        If f Is Nothing Then
            Application.Intersect(c.EntireRow, _
                    c1.Parent.DataBodyRange).Copy rngDest
            Set rngDest = rngDest.Offset(1, 0)
        End If
    Next c
End Sub

回答2:

My brief answer: you'll need to build an array of each of your workbooks' unique IDs, and then filter vis-a-vis the array of the other workbook.
The remaining records will not be matching.

Working prototype:

Sub vkbthjgljskbr()
Dim wb(1) As Workbook, ws(1) As Worksheet, LastRow(1) As Long, FldCounter(1) As Long, _
ListObj(1) As String, FilterList() As String, OutputList() As String, x As Long, FilterArr() As String, RowNum() As Long
Set wb(0) = Workbooks("temp1")                'defining workbooks
    Set wb(1) = Workbooks("temp2")
Set ws(0) = wb(0).Worksheets("Munka1")        'worksheets
    Set ws(1) = wb(1).Worksheets("Munka1")
FldCounter(0) = 2                             'Fields (if your tables do not start at A1 you may need to create another counter)
    FldCounter(1) = 4
ListObj(0) = "Táblázat1"                      'Names of the list objects, actually you could define them as objects too
    ListObj(1) = "Táblázat1"
For j = 0 To 1                                'grabs the index last row of the worksheet
    LastRow(j) = ws(j).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Next

For j = 0 To 1 'removes filters
    If ws(j).ListObjects(ListObj(j)).ShowAutoFilter Then
        ws(j).ListObjects(ListObj(j)).Range.AutoFilter
    End If
Next

UltLastRow = Application.WorksheetFunction.Max(LastRow(0), LastRow(1)) - 1 'outputs the largest of lastrow indices - 1 to show index 0 is valid
    ReDim FilterList(UltLastRow, 1)  'initial filterlist
    ReDim OutputList(UltLastRow, 1)  'complementer list
    ReDim RowNum(UltLastRow, 1)
    ReDim FilterArr(UltLastRow)

For j = 0 To 1 'creates your initial filter lists
    x = 0
    For i = 2 To LastRow(j) 'assuming your table starts at A1
        FilterList(x, j) = ws(j).Cells(i, FldCounter(j)).Value2
        x = x + 1
    Next
Next

For j = 0 To 1 'applies initial filters
    Erase FilterArr
    ReDim FilterArr(UltLastRow)
    For x = 0 To UltLastRow 'not quite elegant way to slice array
        FilterArr(x) = FilterList(x, 1 - j)
    Next
    ReDim Preserve FilterArr(UltLastRow)
    ws(j).ListObjects(ListObj(j)).Range.AutoFilter Field:=FldCounter(j), Criteria1:=FilterArr, Operator:=xlFilterValues
Next

For j = 0 To 1 'grabs hidden (non-matching) values
    x = 0
    Erase FilterArr
    ReDim FilterArr(UltLastRow)
    For i = 2 To LastRow(j) 'assuming your table starts at A1
        If ws(j).Rows("" & i).Hidden Then
            FilterArr(x) = ws(j).Cells(i, FldCounter(j)).Value2
            x = x + 1
        End If
    Next
    If ws(j).ListObjects(ListObj(j)).ShowAutoFilter Then 'removes filters
        ws(j).ListObjects(ListObj(j)).Range.AutoFilter
    End If
    ws(j).ListObjects(ListObj(j)).Range.AutoFilter Field:=FldCounter(j), Criteria1:=FilterArr, Operator:=xlFilterValues 'applies complementer filter
Next
End Sub

Now it works on my sample workbooks.

来源：https://stackoverflow.com/questions/30021830/excel-vba-comparing-two-workbooks

标签

excel

vba

excel-vba

comparison