Question

我有两个单独的工作簿保存在同一个文件位置（工作簿1和工作簿2）

我正在寻找的是一个按3个标准搜索VehicleKey（唯一键号）的宏

YRMANF（制造年份）
CAPCTY（汽车容量）
品牌（汽车品牌）

从workbook1（汽车的宏）到

YearGroup（制造年份）
EngineSize（汽车容量）
MakeDescription（汽车品牌）

来自练习册2（红皮书）。

工作簿2包含大约10000行数据，而我目前的循环方法太慢了。

如果找到匹配项，那么我希望将工作簿2中A列的相应值复制到工作簿1的列J中。以下是Workbook1中填充的值然后匹配Workbook 2

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

我目前有这个工作，但Vlookups大大减慢了打开工作簿1。我目前的工作是：

Option Explicit

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
    Dim i As Integer

    On Error Resume Next

    Application.DisplayAlerts = False
    Application.EnableEvents = False


    Set Sheet1 = ThisWorkbook.Worksheets("#LN00112") '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, "E").End(xlUp).Row > Sheet1.Range("J1").Value Then
        Path = "C:\Users\205331\Desktop\Redbook.xlsx" 'Edit Path File2
        File = Right$(Path, Len(Path) - InStrRev(Path, "\"))

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

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

        For i = 1 To LastRow

            If Sheet1.Range("E" & CellChanged).Value = Sheet2.Range("E" & i) And _
               Sheet1.Range("F" & CellChanged).Value = Sheet2.Range("W" & i) And _
               Sheet1.Range("I" & CellChanged).Value = Sheet2.Range("B" & i) _
               Then

                Sheet1.Range("J" & CellChanged).Value = Sheet2.Range("A" & i).Value

                Found = True

            Else
                Sheet1.Range("J" & CellChanged).Value = ""

            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

    Application.EnableEvents = True
    Application.DisplayAlerts = True

    Exit Sub

End Sub

任何帮助表示赞赏！谢谢。

VBA excel - 基于3个标准进行匹配，并从另一个工作簿中检索值

0 个答案: