创建新工作簿时VBA速度慢

Question

我创建了一个简单的宏来过滤一些数据，将其复制到一个新的工作簿，保存该工作簿并关闭该工作簿。

我打算在大型数据集(其中初始数据集可能是大约10000+行长)上使用它，但是在25行测试中，这需要很长时间(即超过几分钟)。我是新的VBA，想知道为什么这是运行这么慢?

注意:我理解使用Select会影响性能，但是我不认为这是可以避免的。

下面的代码:

Sub Macro7()
'
' Macro7 Macro
'
'
 Application.ScreenUpdating = False
 Application.Calculation = xlManual
 
 Dim cl As Range, rng As Range
 
 Set rng = Range("G3:G5")
 
 For Each cl In rng
        ActiveSheet.Range("$A$2:$D$25").AutoFilter Field:=2, Criteria1:=cl.Value
        Cells.Select
        Selection.Copy
        Workbooks.Add
        ActiveSheet.Paste
        
        Dim Path1 As String
        Dim Path2 As String
        Dim myfilename As String
        Path1 = "C:UsersnameDocuments"
        Path2 = cl.Value
        ActiveWorkbook.SaveAs Filename:=Path1 & "/" & Path2, FileFormat:=xlNormal
        
        ActiveWorkbook.Close
        
        Windows("doc.xlsm").Activate
        Range("A1").Select
        
    Next cl
    
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
    
End Sub

Answer 1

这里的缓慢是由于每次复制整个工作表(100万行左右)-我定义了一个复制范围，这消除了缓慢的问题

Answer 2

你当然可以避免激活和选择，我们应该使用变量:

Sub Macro7()
     Application.ScreenUpdating = False
     Application.Calculation = xlManual
     
     Dim twkb As Workbook
     Dim tws As Worksheet
     
     Dim ws As Worksheet
     Set ws = ThisWorkbook.ActiveSheet
     
     Dim rng As Variant
     Dim cpyrng As Range
     
     rng = Range("G3:G5").Value
     
     Dim fltrng As Range
     Set fltrng = ws.Range("$A$2:$D$25")
    
     Dim i As Long
     For i = LBound(rng, 1) To UBound(rng, 1)
            fltrng.AutoFilter Field:=2, Criteria1:=rng(i, 1)
            Set cpyrng = ws.Range("$A$1").Resize(fltrng.Rows.Count + 1, fltrng.Columns.Count).SpecialCells(xlCellTypeVisible)
            
            Set twkb = Workbooks.Add
            Set tws = twkb.Worksheets(1)
            
            cpyrng.Copy tws.Range("A1")
            
            Dim Path1 As String
            Dim Path2 As String
            Dim myfilename As String
    
            Path1 = "C:UsersnameDocuments"
            Path2 = rng(i, 1)
            twkb.SaveAs Filename:=Path1 & "/" & Path2, FileFormat:=xlNormal
            
            twkb.Close
        Next i
        
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

注意，这可能不会提高性能。瓶颈将是工作簿的创建和保存。