VBA excel - 从另一个工作簿匹配和检索值

VBA excel - match and retrive values from another workbook

提问by brittd

I'm very new to VBA so not sure where to start with this one. I have two separate workbooks saved in the same file location (Workbook 1 and Workbook 2)

我对 VBA 很陌生，所以不确定从哪里开始。我有两个单独的工作簿保存在同一个文件位置（工作簿 1 和工作簿 2）

what i'm looking for is When column C is populated in workbook 1, I want a macro that searches for that number in workbook 2 (column A).

我正在寻找的是当 C 列填充在工作簿 1 中时，我想要一个宏来在工作簿 2（A 列）中搜索该数字。

If a match is found then I want the corresponding values from column C, D, E and G in Workbook 2 to be copied onto workbook 1. Here is the values populated in Workbook1, then matched in Workbook2Here is the expected results, with the matched values populating Workbook1

如果找到匹配项，那么我希望将工作簿 2 中 C、D、E 和 G 列中的相应值复制到工作簿 1 中。这是在工作簿 1 中 填充的值，然后在工作簿 2 中匹配这是预期的结果，其中匹配的值填充 Workbook1

Workbook 2 won't be opened by the user, they will just click a button in Workbook1 and it will populate the data.

用户不会打开工作簿 2，他们只需单击工作簿 1 中的按钮即可填充数据。

I currently have this working but with Vlookups which has greatly slowed down opening workbook 1.

我目前有这个工作，但使用 Vlookups 大大减慢了打开工作簿 1 的速度。

any help is appreciated.

任何帮助表示赞赏。

回答by UGP

Put this into the Code of the Sheet you are using in File1 and edit the Sheetnames and the Path. You dont need to press a button or anything, the macro will activate if the data in Column C changes and load the data of File2 into File1.

将其放入您在 File1 中使用的工作表代码中，然后编辑工作表名称和路径。您不需要按任何按钮或任何东西，如果 C 列中的数据发生变化，宏将激活并将 File2 的数据加载到 File1 中。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim Sheet1, Sheet2 As Worksheet
Dim CellChanged As Integer
Dim Path, File As String
Dim LastRow As Long

Path = "C:\Users\User\Desktop.xlsx" 'Edit Path File2
File = Right$(Path, Len(Path) - InStrRev(Path, "\"))

Set Sheet1 = ThisWorkbook.Worksheets("Tabelle1") 'Edit Sheet File1

Set KeyCells = Range("C:C")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then

   CellChanged = Target.Row

   Workbooks.Open (Path)
   Set Sheet2 = Workbooks(File).Worksheets("Tabelle1") 'Edit Sheet of File2

   LastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 1 To LastRow
        If Sheet1.Range("C" & CellChanged).Value = Sheet2.Range("A" & i) Then
            Sheet1.Range("D" & CellChanged).Value = Sheet2.Range("B" & i).Value 'Date
            Sheet1.Range("E" & CellChanged).Value = Sheet2.Range("C" & i).Value 'Amount
            Sheet1.Range("F" & CellChanged).Value = Sheet2.Range("F" & i).Value 'Payee
            Sheet1.Range("G" & CellChanged).Value = Sheet2.Range("D" & i).Value 'Pol Number
            Exit For
        End If
    Next i
    Workbooks(File).Close savechanges:=False
End If
End Sub

EDIT: Macro to start with a button with multiple edits (last cell change store in H1). Also added an Error handle.

编辑：宏以具有多个编辑的按钮开始（H1 中的最后一个单元格更改存储）。还添加了一个错误句柄。

Sub WithButton()
Dim KeyCells As Range
Dim Sheet1, Sheet2 As Worksheet
Dim CellChanged As Integer
Dim Path, File As String
Dim LastRow, LastData As Long
Dim Found As Boolean

On Error GoTo Handle

            Set Sheet1 = ThisWorkbook.Worksheets("Tabelle1") 'Edit Sheet File1

            If Sheet1.Range("H1").Value = "" Then
    Sheet1.Range("H1").Value = 0
    CellChanged = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row
End If

If Sheet1.Cells(Rows.Count, "C").End(xlUp).Row > Sheet1.Range("H1").Value Then
    Path = "C:\Users\L4R21D\Desktop.xlsx" 'Edit Path File2
    File = Right$(Path, Len(Path) - InStrRev(Path, "\"))

    CellChanged = Sheet1.Range("H1").Value + 1
    Workbooks.Open(Path)
            Set Sheet2 = Workbooks(File).Worksheets("Tabelle1") 'Edit Sheet of File2

               LastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
    LastData = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row

    For i = 1 To LastRow
        If Sheet1.Range("C" & CellChanged).Value = Sheet2.Range("A" & i) Then
            Sheet1.Range("D" & CellChanged).Value = Sheet2.Range("B" & i).Value
            Sheet1.Range("E" & CellChanged).Value = Sheet2.Range("C" & i).Value
            Sheet1.Range("F" & CellChanged).Value = Sheet2.Range("F" & i).Value
            Sheet1.Range("G" & CellChanged).Value = Sheet2.Range("D" & i).Value
            Found = True
        End If
        If Found = True Or i = LastRow Then
            If CellChanged = LastData Then
                Exit For
            End If
            If Found = True Then
                Found = False
                CellChanged = CellChanged + 1
            End If
            i = 0
        End If
    Next i
    Workbooks(File).Close savechanges:=False
                Sheet1.Range("H1").Value = CellChanged
End If
Exit Sub
Handle:
    MsgBox("Error")
End Sub