VBA中的Vlookup运行非常慢，有什么想法吗？

Question

I have created the following macro to be able to have a sheet called "Macron" which looks inside different cells and sheets in my workbook, from there i want to create a macro that finds the value based on a name instead of a specific cell (since VBA code does not get updated if i add another cell etc, then i need to rewrite all the macro references which is extremely timeconsuming).

So i decided to work with the application.Vlookup function in my code, but now i see that this goes extremely slow compared to only looking inside the cells.

Is this the case all the time, or is it something wrong with my code that could be updated or cleaner to make it work faster.

Here is my code for the macro:

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

Thanks for any help that can be offered.

Best regards Agatonsaxx

Answer 1

To skip the tremendous amount of vlookups (combined with them being for whole columns and not smaller defined ranges), while using VBA I suggest using a single iteration over column A to determine the contents of your mail body. For that purpose you need 2 arrays. One for the words you are looking for in column A ( searchWords ) and one for the needed values in column C ( mailContents ). My approach would be as follows ("..." marking skips that need to be filled in with your existing code):

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

As you can see, I only filled in the first 3 words of the mail body. You'd need to fill searchWords with the mail body lookups and further fill the mail body. I'd also recommend to change the size of the arrays to the exact number of lookups your formerly did (1 To 100 means that it can contain up to 100 entries).