我有一个Excel宏，在大多数情况下基本上都可以正常工作，但是有三个问题困扰着我。
代码长了一点，所以我减少了代码以解决问题：（这些问题也在我的代码中标记。）
Nr.1：uniqueArray包含多个条目时，Dim和item的uniqueArray可以。但是，当我测试了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
关于其中一个问题有什么想法吗？
您可以使用下面的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