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

如您所见，我只填写邮件正文的前3个单词。您需要使用邮件正文查找填充searchWords并进一步填写邮件正文。我还建议将数组的大小更改为您以前执行的确切查找次数（1到100表示它最多可包含100个条目）。

VBA中的Vlookup运行速度很慢，有什么想法吗？

1 个答案: