使用VBA对单独表格中的2个数据表进行双向比较

时间:2015-06-29 18:35:25

标签: excel vba excel-vba

这里的第一个问题。我正在寻找一种方法来基本上比较2个小数据集/表,并在表1的列a中查找附加或不存在于'主数据库中的值。表并在第三列中包含一些消息。这是在VBA。

在2个示例表中,可能更容易解释我希望得到的输出。

Sheet1的列a和b中的表1:

A       B
a12     horse

b23     dog

f54     cat

Sheet2的列a和b中的表2:

A       B
b23     dog

f54     cat

i09     tiger

期望的输出:

a12 horse警告:这是表2中没有的附加值

b23狗

f54 cat

i09 tiger警告:此值是预期的,但表1中未显示

感谢您的帮助,如果有更多细节可以让我更容易回答,请告诉我

1 个答案:

答案 0 :(得分:0)

首先要注意两次是同一个问题。

您基本上需要扫描表A的行以查看它们是否在表B中。在哪里输出行,其中只有表A的行输出带有消息的行。

所以你首先使用表1作为表A,然后再使用表2作为表B.在第一个结尾处添加第二个的输出。

如果不了解更多关于VBA能力的信息,很难提供更多建议。 您的示例还提供了两列。是否需要比较两个列,还是只需要比较一个?我假设两者(最糟糕的情况)。

您实际上正在使用UNION集合运算符添加所有唯一行,以便您可以调整使用的方法here 。您必须根据需要对文本进行调整,以描述行所独有的表格。

或者,您可以编写VBA循环,就像这样(我认为它会为您提供所需的东西)。

将其粘贴到新模块中并运行Main()。您需要定义工作表和范围。

Option Explicit

Dim s1 As Worksheet
Dim s2 As Worksheet
Dim sOutput As Worksheet
Dim NextOutputRow As Range


Sub CompareTwoTables(TableA As Range, TableB As Range, NameOfTableB As String, OutputIfRowsMatch As Boolean)

    Dim TableArow As Long
    Dim TableBrow As Long
    Dim TableACell As Range
    Dim TableBCell As Range
    Dim FoundMatchingRow As Boolean
    Dim ColumnDifferencesDetected As Boolean

    TableA.Parent.Select ' useful for debugging - selects teh sheet

    For TableArow = 1 To TableA.Rows.Count

        FoundMatchingRow = False

        For TableBrow = 1 To TableB.Rows.Count

            ColumnDifferencesDetected = False

            Set TableACell = TableA.Cells(TableArow, 1)
            Set TableBCell = TableB.Cells(TableBrow, 1)

            TableACell.Select ' useful for debugging
            Debug.Print TableACell.Address, TableBCell.Address ' useful for debugging

            If TableACell.Value = TableBCell.Value Then
                If TableA.Cells(TableArow, 2) = TableB.Cells(TableBrow, 2) Then
                    FoundMatchingRow = True
                Else
                    ColumnDifferencesDetected = True
                End If

            End If


            If FoundMatchingRow Or ColumnDifferencesDetected Then
                Exit For ' TableBrow
            End If

        Next TableBrow


        If FoundMatchingRow Then
            If OutputIfRowsMatch Then
                NextOutputRow.Cells(1, 1) = TableA.Cells(TableArow, 1)
                NextOutputRow.Cells(1, 2) = TableA.Cells(TableArow, 2)

                Set NextOutputRow = NextOutputRow.Offset(1, 0)

            End If

        ElseIf ColumnDifferencesDetected Then

            NextOutputRow.Cells(1, 1) = TableA.Cells(TableArow, 1)
            NextOutputRow.Cells(1, 2) = TableA.Cells(TableArow, 2)
            NextOutputRow.Cells(1, 2) = "One only one column was the same"

            Set NextOutputRow = NextOutputRow.Offset(1, 0)

        Else
            NextOutputRow.Cells(1, 1) = TableA.Cells(TableArow, 1)
            NextOutputRow.Cells(1, 2) = TableA.Cells(TableArow, 2)
            NextOutputRow.Cells(1, 3) = "This value was expected but not present in " & NameOfTableB

            Set NextOutputRow = NextOutputRow.Offset(1, 0)

        End If



    Next TableArow

End Sub

Sub main()

    Dim Table1 As Range
    Dim Table2 As Range

    ' Three sheets must exist
    Set s1 = Worksheets("Sheet1")
    Set s2 = Worksheets("Sheet2")
    Set sOutput = Worksheets("Sheet3")

    Set Table1 = s1.Range("A2:B10")  ' Allows for a title row and two columns
    Set Table2 = s2.Range("A2:B10")

    ' Clear any previous output
    sOutput.Cells.ClearContents

    Set NextOutputRow = sOutput.Range("2:2") ' Allows for a title row

    CompareTwoTables TableA:=Table1, TableB:=Table2, NameOfTableB:="Table2", OutputIfRowsMatch:=True

    CompareTwoTables TableA:=Table2, TableB:=Table1, NameOfTableB:="Table1", OutputIfRowsMatch:=False

    sOutput.Select

    MsgBox "Done"

End Sub
相关问题