在不同工作表的列中查找匹配项，然后将特定单元格复制粘贴到 VBA 中的匹配行

Question

我有两本工作簿，一本名为“LocalBooks”，另一本名为“CentralIndex”。 “LocalBooks”表中的所有条目都有唯一的参考编号。 我正在尝试编写一些内容，用匹配的参考号在“CentralIndex”中查找一行，然后更新该行中的特定列。 （我知道匹配和更新整行是一个常见问题，但我找不到它只是为了更新行中的特定列）

工作簿：“Localbooks” - 请假设第一个单元格地址是 A1，工作表名称是书籍

工作簿：“CentralIndex” - 请假设第一个单元格地址是 A1，工作表名称是 Central Index

如果我的代码运行正确，我希望“中央索引”看起来像这样：

更新了第 2 (C2,E2,I2)、6 (C6,E6,I6) 和 10 行。

注意事项/限制

• 以上是我的任务的样本表，因为我无法共享实际数据，但实际数据集看起来超过 200 行。

• “中央索引”表中不会有任何重复的参考编号。 所以多次匹配不是问题。

• 我确实考虑过使用数组，但一直坚持保存“书籍”中的多列值，然后将它们放在不同的列中。 如果有办法做到这一点，那么我欢迎它。

• 我不能使用经典的索引/匹配或其他公式解决方案，因为要求是“按按钮进行更新”，我无法修改“中央索引”表。

• 在一个非常理想的世界中，我希望代码还能突出显示“本地图书”中与“中央索引”不匹配的任何行。 但由于我的代码非常不工作，我还没有走那么远。

我下面的代码使用 match 函数来查找行地址，但是当我去运行它时，似乎什么也没发生....

Sub Update()

    Dim wbLocal As Workbook
    Dim wbCentral As Workbook
    Dim wsBooks As Worksheet
    Dim wsCentral As Worksheet
    Dim lrBooks As Long
    Dim lrCentral As Long
    Dim i As Long
    Dim rc As Variant
    
    Set wbLocal = Workbooks("LocalBooks.xlsx")
    Set wbCentral = Workbooks("CentralIndex.xlsx")
    Set wsBooks = wbLocal.Worksheets("Books")
    Set wsCentral = wbCentral.Worksheets("Central Index")

    lrBooks = wsBooks.Cells(wsBooks.Rows.Count, 1).End(xlUp).Row
    lrCentral = wsCentral.Cells(wsCentral.Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lrCentral
        rc = Application.Match(wsCentral.Cells(i, 1).Value, wsBooks.Range("A1:A" & lrBooks), 0)
        If Not IsError(rc) Then
            wsBooks.Range("D").Select
            Selection.Copy
            Windows("CentralIndex.xlsx").Activate
            wsCentral.Range("C").Select
            ActiveSheet.Paste
            Windows("LocalBooks.xlsx").Activate
        End If
    Next

End Sub

调试似乎没有任何结果，所以我什至无法看到复制粘贴部分是否有效。 （我知道复制粘贴的当前迭代不会让我得到上面的结果，我只是想看看在将它用于其他单元格之前我所做的工作是否有效）。

很高兴提供更多信息，并提前致谢。 保证我从我提出的每个问题中学到了很多:)

Answer 1

使用以参考号作为键和相应的索引表行号作为值的字典对象。

Option Explicit

Sub Update()

    Dim wbLocal As Workbook, wbCentral As Workbook
    Dim wsBooks As Worksheet, wsCentral As Worksheet
    Dim lrBooks As Long, lrCentral As Long
    Dim i As Long, r As Long, rc As Variant
    Dim n As Long, m As Long

    Dim dict As Object, key As String
    Set dict = CreateObject("Scripting.Dictionary")
    
    Set wbLocal = Workbooks("LocalBooks.xlsx")
    Set wbCentral = Workbooks("CentralIndex.xlsx")
    Set wsBooks = wbLocal.Worksheets("Books")
    Set wsCentral = wbCentral.Worksheets("Central Index")

    ' build lookup
    With wsCentral
        lrCentral = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = 2 To lrCentral
            key = Trim(.Cells(i, "B"))
            If dict.exists(key) Then
                MsgBox "Duplicate Ref No '" & key & "'", vbCritical, "Row " & i
                Exit Sub
            ElseIf Len(key) > 0 Then
                dict.Add key, i
            End If
        Next
    End With

    ' scan books, match ref numbers and update index
    With wsBooks
        lrBooks = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lrBooks
            key = Trim(.Cells(i, "A"))
            If dict.exists(key) Then
                r = dict(key)
                wsCentral.Cells(r, "C") = .Cells(i, "D") ' Status
                wsCentral.Cells(r, "E") = .Cells(i, "E") ' Date last loaned
                wsCentral.Cells(r, "I") = .Cells(i, "H") ' Currently loaned to
                n = n + 1
            Else
                .Rows(i).Interior.Color = RGB(255, 255, 0)
                m = m + 1
            End If
        Next
    End With
    MsgBox n & " records updated" & vbLf & m & " rows not found", vbInformation
End Sub

Answer 2

如果您想在 vba 中执行此操作，您应该使用“字典”。 例如， 运行时“6”溢出错误 - 用于股票分析的重构代码

但根据您的描述，我建议使用“Powerquery”。 在您的“CentralIndex”工作簿中：

1. 转到菜单数据 > 获取数据 > 从文件 > 从工作簿 => 选择“Localbooks.xlsx”并选择要加载的工作表
2. 点击“转换数据”
3. 在左上角您会看到“关闭并加载”按钮，确保单击小三角形并选择“关闭并加载到”，检查：仅连接。
4. 转到“CentralIndex”中的工作表，单击单元格 A1
5. 转到菜单数据>单击“从表格范围”并选中“我的表格有标题”

如果一切顺利，您将返回到 powerquery 并且您有 2 个查询（如果您没有看到它们，请单击左侧）。 匹配：

1. 选择其中1个，点击要匹配的列
2. 在菜单“主页”>“合并查询”=> 选择要匹配的第二个表和列，将 joinKind 留在左侧并点击确定。
3. 您应该会看到一个带有 dubbel 箭头的新列，单击箭头并选择要添加的列。
4. 点击菜单“关闭并加载”，这次选择第一个选项并加载到新工作表

让我知道它是怎么回事，或者你是否被卡住了。