什么是正确的 Dim 类型，为什么我的宏变慢了？

Question

我有一个 Excel 宏，基本上在大多数情况下都可以正常工作，但有三个问题困扰着我。

代码有点长，所以我减少了它以解决问题：（这些问题也在我的代码中标记。）

Nr.1：当 uniqueArray 包含多个条目时，item 和 uniqueArray 的 Dim 可以。但是当我测试了uniqueArray 仅包含一个条目的不太可能的情况时，我得到了错误，即类型不匹配。我通常不在 Excel 中编程，所以我对 vba 中的不同类型并不十分熟悉。我在这里需要数组还是可以只更改Dim？

Nr.2：代码越来越慢，宏添加到工作簿的工作表越多。这是正常行为，还是我可以加快我的代码速度？

Nr.3：几年前，我遇到了一个慢宏的问题。然后我找到了强制暂停的提示。我用这个宏再次尝试过，它把速度提高了很多时间。为什么暂停会加快宏的速度？

   Sub Three_Issues()
    Dim ColumnLetter As String
    Dim cell As Range
    Dim sheetCount, TotalRow, TotalCol As Integer
    'Dim item, uniqueArray As Variant
    Dim item, uniqueArray() As Variant
    Dim lastRow As Long

    Application.ScreenUpdating = False

    'Get unique brands:
    With Sheets("Brand")
    .Columns(1).EntireColumn.Delete
    Sheets("Sales").Columns("R:R").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A1"), Unique:=True
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    'uniqueArray = .Range("A3:A" & lastRow)
    'Update:
    If .Range("A3:A" & lastRow).Cells.Count = 1 Then
    ReDim uniqueArray(1, 1)
    uniqueArray(1, 1) = .Range("A3")
    Else
    uniqueArray = .Range("A3:A" & lastRow).Value
    End With

    TotalRow = Sheets("Sales").UsedRange.Rows.Count
    TotalCol = Sheets("Sales").UsedRange.Columns.Count
    ColumnLetter = Split(Cells(1, TotalCol).Address, "$")(1) 'Num2Char
    sheetCount = 0 'Counter for statusbar

For Each item In uniqueArray 'item=Brand
'->Issue 1: Runtimer error 13 Types don't match: This happens if the uniqueArray consists of only one brand.
'Then item is Variant/Empty and uniqueArray is Variant/String
'If uniqueArray consists of more than one brand - which is usually the case - it works fine.
'item=Variant/Empty uniqueArray=e.g. Variant/Variant(1 to 2, 1 to 1)
'Can I change the Dim statement to solve this special case, or do I need arrays maybe?

    'Filter sales for each brand:
    With Sheets("Sales")
    .Range(.Cells(2, 1), .Cells(TotalRow, TotalCol)).AutoFilter Field:=18, Criteria1:=item
    End With

    With Sheets("Agents")
    'Delete old...
    .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)).Clear
    '...and get new
    Sheets("Sales").Range(Sheets("Sales").Cells(3, 2), Sheets("Sales").Cells(2, 2).End(xlDown)).SpecialCells(xlCellTypeVisible).Copy
    .Range("A2").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    End With

    'List with all agents
    For Each cell In Worksheets("Agents").Range("A2", Worksheets("Agents").Range("A1").End(xlDown))

    With Sheets("Report")
    .Range("I4") = cell 'Copy agent and update the formulas within the report
'->Issue 2: It takes around 10 seconds to fill 10 sheets with the reports of 10 agents.
'When I reach 70-80 sheets, it slows down to 30 seconds for 10 sheets.
'Is this just because of the number of sheets, or can I speed it up again?

    .Range(.PageSetup.PrintArea).Copy
    Sheets.Add After:=Sheets("Report")

    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value 'Replace all formulas with values
    Application.CutCopyMode = False
    ActiveSheet.Name = cell

    sheetCount = sheetCount + 1
    If sheetAnz Mod 10 = 0 Then Application.StatusBar = sheetAnz 'Get statusupdate every 10 sheets
    End With
    Next

'->Issue 3: I create up to 400 sheets and when I want to continue and do some sorting of the sheets for example it takes a very long time.
'But if I add this break for a second, it works reasonably fine again. Why is that? Does vba needs the break to catch up with itself?
'Since the issue is not the sorting and the other stuff after the pause.

 Application.Wait (Now + TimeValue("0:00:01")) 'Code becomes faster after that...

    'Continue with other stuff.... sorting sheets and so on

Next

    Application.ScreenUpdating = True

End Sub

对其中一个问题有什么想法吗？

Answer 1

您可以使用下面的UDF 输出具有 1 个值或多个值的数组。 这也将受益于传递一个工作表变量，以便可以正确限定对象

---

像这样从当前宏调用函数

uniqueArray = MyArr(lastrow)

---

Public Function MyArr(lastrow As Long) As Variant

If Range("A3:A" & lastrow).Cells.Count = 1 Then
    ReDim MyArr(1, 1)
    MyArr(1, 1) = Range("A3")
Else
    MyArr = Range("A3:A" & lastrow).Value
End If

End Function