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

【问题标题】：VBA Excel Compare Two Lists for Matches, Output Results on Separate SheetVBA Excel 比较两个列表的匹配项，在单独的工作表上输出结果
【发布时间】：2013-03-27 18:30:55
【问题描述】：

情况如下：

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

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

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

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

这是我的问题：

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

这是我的代码。它可能不是最佳的，但我只需要运行一次比较。即使花费了 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

【问题讨论】：

“但是当我将它复制到原件，进行任何适当的更改时，代码不再有效” - 这表明您没有进行所有适当的更改！似乎您的“测试”和“生产”工作簿之间存在一些差异，这些差异未在您的代码中考虑。从您的问题中的信息很难判断这些可能是什么。
同意。我想一个更好的问题是，我的循环结构有什么固有的错误吗？我尝试对其进行设置，使其以人类的方式扫描列表：选择 sheet1 上的第一个机构，然后扫描 sheet2 直到找到它。找到后，记下信息，然后移至 sheet1 上的下一项。如果没有找到，请继续扫描。

标签： excel vba loops compare

【解决方案1】：

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

【讨论】：

谢谢，就是这样！我有一两列隐藏了，这让我无法计算。非常感谢！

【解决方案2】：

也许使用 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

【讨论】：