VBA中的Vlookup運行非常慢，有什么想法嗎？

Question

我創建了以下宏，以便能夠擁有一個名為“ Macron”的工作表，該工作表可以在工作簿的不同單元格和工作表中查找，然后我要創建一個宏，該宏根據名稱而不是特定的單元格來查找值（由於如果我添加另一個單元等，VBA代碼不會更新，那么我需要重寫所有的宏引用，這非常耗時。

因此，我決定在代碼中使用application.Vlookup函數，但是現在我看到，與僅在單元格內部進行查看相比，這非常慢。

一直都是這種情況，還是我的代碼有問題，可以對其進行更新或更清潔以使其更快地工作。

這是我的宏代碼：

Sub Motesbokning_saljare()
Dim OutApp As Object
Dim OutMail As Object
Dim a As String
Dim o As String
Dim a1 As String
Dim o1 As String
Dim strbody As String
Dim ws As Worksheet
Dim ws1 As Worksheet

' ä
a = Chr(228)
'å
a1 = Chr(229)
'ö
o = Chr(246)
'Ö
o1 = Chr(214)

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(1)
Set ws = Sheets("Macron")
Set ws1 = Sheets("Offert")

On Error Resume Next
With OutMail
    .To = Application.VLookup("kundEpost", ws.Range("A:C").Value, 3, False)
    .Subject = Application.VLookup("partnerNamn", ws.Range("A:C").Value, 3, False) & ", " & Application.VLookup("kundFulltNamn", ws.Range("A:C").Value, 3, False)
    .location = "" & Application.VLookup("kundAdress", ws.Range("A:C").Value, 3, False) & ", " & Application.VLookup("kundPostnr", ws.Range("A:C").Value, 3, False) & ", " & Application.VLookup("kundPostort", ws.Range("A:C").Value, 3, False)
    .Body = "Projekttyp: " & Application.WorksheetFunction.VLookup("moteProjekttyp", ws.Range("A:C").Value, 3, False) & vbNewLine & "Fastighetstyp: " & Application.WorksheetFunction.VLookup("moteFastighetstyp", ws.Range("A:C").Value, 3, False) & vbNewLine & vbNewLine & "Portkod: " & _
    Application.VLookup("motePortkod", ws.Range("A:C").Value, 3, False) & vbNewLine & "Telefon: " & Application.VLookup("kundTelefon", ws.Range("A:C").Value, 3, False) & vbNewLine & "V" & a1 & "ning: " & Application.VLookup("moteVaning", ws.Range("A:C").Value, 3, False) & vbNewLine & vbNewLine _
    & "Upphandlingsunderlag: " & Application.VLookup("moteUpphandlingsunderlag", ws.Range("A:C").Value, 3, False) & vbNewLine & Application.VLookup("moteUpphandlingsunderlagTyp", ws.Range("A:C").Value, 3, False) & vbNewLine & vbNewLine & "K" & o & "rtid: " & Application.VLookup("moteKortid", ws.Range("A:C").Value, 3, False) & " minuter" _
    & vbNewLine & "GPS URL: " & Application.VLookup("moteGPSurl", ws.Range("A:C").Value, 3, False) & vbNewLine & vbNewLine & "K" & a & "lla: " & Application.VLookup("moteKalla", ws.Range("A:C").Value, 3, False) & vbNewLine & o1 & "vrigt: " & Application.VLookup("moteOvriginfo", ws.Range("A:C").Value, 3, False) & vbNewLine & vbNewLine & "Referenskund i n" & a & _
    "romr" & a1 & "de: " & vbNewLine & ws1.Range("I35").Value & ", " & ws1.Range("K35").Value & ", " & ws1.Range("M35").Value & vbNewLine & ws1.Range("I36").Value & ", " & _
    ws1.Range("K36").Value & ", " & ws1.Range("M36").Value & vbNewLine & ws1.Range("I37").Value & ", " & ws1.Range("K37").Value & ", " & ws1.Range("M37").Value & vbNewLine & _
    ws1.Range("I38").Value & ", " & ws1.Range("K38").Value & ", " & ws1.Range("M38").Value & vbNewLine & ws1.Range("I39").Value & ", " & ws1.Range("K39").Value & ", " _
    & ws1.Range("M39").Value
    .Start = Application.VLookup("moteDatum", ws.Range("A:C").Value, 3, False) + Application.VLookup("moteKlockslag", ws.Range("A:C").Value, 3, False)
    .ReminderMinutesBeforeStart = Application.VLookup("moteReminder", ws.Range("A:C").Value, 3, False)
    .Duration = Application.VLookup("moteTidsatgang", ws.Range("A:C").Value, 3, False)
    .Recipients.Add Application.VLookup("moteLaggTillDeltagare", ws.Range("A:C").Value, 3, False)
    .Categories = Application.VLookup("moteKategori", ws.Range("A:C").Value, 3, False)
    .Display
End With

Set OutMail = Nothing
Set OutApp = Nothing

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

感謝您提供的任何幫助。

最好的問候Agatonsaxx

Answer 1

為了跳過大量的vlookup（將它們組合在一起用於整個列而不是較小的定義范圍），在使用VBA時，我建議對A列使用一次迭代來確定郵件正文的內容。 為此，您需要2個陣列。 一個用於在A列中查找的單詞（ searchWords ），另一個用於在C列中所需的值（ mailContents ）。 我的方法如下（“ ...”標記跳過，需要用您現有的代碼填充）：

Sub Motesbokning_saljare()
    ...
    Set ws = Sheets("Macron")
    Set ws1 = Sheets("Offert")

    Dim searchWords(1 To 100) As String
    'Fill all the words that need to be searched:
    searchWords(1) = "kundEPost"
    searchWords(2) = "partnerNamn"
    searchWords(3) = "kundFulltNamn"
    ...
    Dim mailContents(1 To 100) As String
    Dim i As Integer
    Dim j As Integer
    Dim LastRow As Long
    With ws
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    For i = 1 To LastRow
        'i is for the rows of the excel sheet
        For j = 1 To UBound(searchWords)
            'j is for the lookup in the array searchwords
            If ws.Cells(i, 1) = searchWords(j) Then
                mailContents(j) = ws.Cells(i, 3)
            End If
        Next j
    Next i
    'Now, fill the mail body:
    On Error Resume Next
    With OutMail
        .To = mailContents(1)
        .Subject = mailContents(2) & ", " & mailContents(3)
        ...
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

    ...
End Sub

如您所見，我只填寫了郵件正文的前三個字。 您需要用郵件正文查找填充searchWords ，然后進一步填充郵件正文。 我還建議將數組的大小更改為您以前執行的查找的確切數目（1到100表示​​它最多可以包含100個條目）。