VBA Excel 比较两个匹配列表，在单独的工作表上输出结果

VBA Excel Compare Two Lists for Matches, Output Results on Separate Sheet

提问by user1905080

Here is the situation:

这是情况：

I am verifying institution data in a database. Each institution has a code associated with it. I want to be sure that the codes in our database are correct and also check that the names in our database contain no errors. I would do this manually, but there are some 1200 records to check.

我正在验证数据库中的机构数据。每个机构都有一个与之相关的代码。我想确保我们数据库中的代码是正确的，并检查我们数据库中的名称是否包含错误。我会手动执行此操作，但要检查大约 1200 条记录。

All my data is contained in a single workbook.

我的所有数据都包含在一个工作簿中。

• The first sheet is the information from our database. The institution name is in column B and the code is in column K. The code is stored as a number.
• The second sheet is the up-to-date information. The institution name is in column A and the code is in column D. The code is also stored as a number.
• The third sheet is set up for the results

• 第一张表是我们数据库中的信息。机构名称在 B 列中，代码在 K 列中。代码存储为数字。
• 第二张表是最新信息。机构名称在 A 列中，代码在 D 列中。代码也存储为数字。
• 第三张表为​​结果设置

I want to match codes in the first sheet with codes in the second sheet, then output the results on the third sheet. I want for each code to have a row containing: the institution name from sheet 1, the code, and the institution name from the second sheet. I want to do this so that I can check that the code is valid, that the code in our database corresponds to the correct institution, and finally so I can check the institution name for formatting and other discrepancies.

我想将第一张纸中的代码与第二张纸中的代码相匹配，然后在第三张纸上输出结果。我希望每个代码都有一行包含：表 1 中的机构名称、代码和第二张表中的机构名称。我想这样做是为了检查代码是否有效，我们数据库中的代码是否与正确的机构相对应，最后我可以检查机构名称的格式和其他差异。

Here are my problems:

这是我的问题：

1. Rather than use the original workbook and somehow corrupt the data, I created a copy to test the code on. I wrote a program which works in the test file, but when I copy it over to the original, making any appropriate changes, the code no longer works. Why might this be?
2. Since copying the code seemed to create some problem, I retyped the code, verbatim, into the original file. It worked. But, only sort of. The code ran, but would only execute part of the code contained in the conditional. It would execute the first line in the block, but then skip the rest and then never enter the conditional again. Since everything is indented properly, what could cause this to happen?
3. To try to detect why all of these problems occur, I've tried stepping through the program using F8. It steps through, but never enters the conditional. It just traverses the loops. When using the Step Into (F8) command, does it not evaluate IF statements?
4. To test if my loops are functioning properly, rather than run through ALL the records and have to wait, I will change the FOR loop condition from 1170 to 11. Nothing has changed except the number of times the loop runs. Yet, the program no longer executes. When I change the number back, it works. Why might this be?

1. 我没有使用原始工作簿并以某种方式破坏数据，而是创建了一个副本来测试代码。我编写了一个在测试文件中运行的程序，但是当我将它复制到原始文件中并进行任何适当的更改时，代码不再起作用。 为什么会这样？
2. 由于复制代码似乎产生了一些问题，我将代码逐字重新输入到原始文件中。有效。但是，只是一种。代码运行了，但只会执行条件中包含的部分代码。它会执行块中的第一行，然后跳过其余部分，然后再也不输入条件。 既然一切都正确缩进，什么会导致这种情况发生？
3. 为了尝试检测所有这些问题发生的原因，我尝试使用 F8 单步执行程序。它逐步通过，但从不进入条件。它只是遍历循环。 使用 Step Into (F8) 命令时，它不评估 IF 语句吗？
4. 为了测试我的循环是否正常运行，而不是遍历所有记录并必须等待，我将 FOR 循环条件从 1170 更改为 11。除了循环运行的次数外，没有任何变化。然而，程序不再执行。当我改回号码时，它起作用了。 为什么会这样？

Here is my code. It may not be optimal, but I only need to run the comparison ONCE. Even if it took 2 hours, it would be less work than checking them all manually. I know this code works, because I got it to work in the test file. But why doesn't it work in the original and what can I do to make it work?

这是我的代码。它可能不是最佳的，但我只需要运行一次比较。即使需要 2 个小时，也比手动检查所有工作要少。我知道这段代码有效，因为我让它在测试文件中工作。但是为什么它在原始版本中不起作用，我该怎么做才能使它起作用？

Sub FindMatches()

    Dim oldRow As Integer
    Dim newRow As Integer
    Dim i As Integer

    i = 2

    For oldRow = 2 To 1170
        For newRow = 2 To 1170
            If Worksheets("Sheet1").Cells(oldRow, 9) = Worksheets("Sheet2").Cells(newRow, 4) Then

                Worksheets("Sheet3").Cells(i, 1) = Worksheets("Sheet1").Cells(oldRow, 2)
                Worksheets("Sheet3").Cells(i, 2) = Worksheets("Sheet1").Cells(oldRow, 9)
                Worksheets("Sheet3").Cells(i, 3) = Worksheets("Sheet2").Cells(newRow, 1)

                i = i + 1

                Exit For
            End If
        Next newRow
    Next oldRow

End Sub

回答by Steven Marciano

I think you are referencing the wrong column. Column K is 11 not 9

我认为您引用了错误的列。K 列是 11 而不是 9

回答by Tim Williams

Maybe use Find() instead of the inner loop:

也许使用 Find() 而不是内部循环：

Sub FindMatches()

    Dim shtOld As Worksheet, shtNew As Worksheet, shtMatch As Worksheet
    Dim oldRow As Integer
    Dim newRow As Integer
    Dim i As Integer, id, f As Range

    i = 2

    Set shtOld = ThisWorkbook.Sheets("Sheet1")
    Set shtNew = ThisWorkbook.Sheets("Sheet2")
    Set shtMatch = ThisWorkbook.Sheets("Sheet3")

    For oldRow = 2 To 1170

        id = shtOld.Cells(oldRow, 9)

        Set f = shtNew.Range("D2:D1170").Find(id, , xlValues, xlWhole)
        If Not f Is Nothing Then
            With shtMatch.Rows(i)
                .Cells(1).Value = shtOld.Cells(oldRow, 2)
                .Cells(2).Value = id
                .Cells(3).Value = f.EntireRow.Cells(1)
            End With
            i = i + 1
        End If

    Next oldRow

End Sub