加快VBA宏的速度：打开/关闭多个工作簿以对数据进行排序

Question

我已经编写了一个宏来处理用户选择的文件夹中的所有excel文件，然后将处理后的文件另存为新文件到新文件夹中（“最终”）。我有宏，但是慢。您对我如何提高速度有任何建议吗？

Sub PreProcessing()

Application.Calculation = xlCalculationManual
Application.EnableAnimations = False
Application.DisplayStatusBar = False

'Choose Folder
Set FolderPath = Application.FileDialog(msoFileDialogFolderPicker)
    With FolderPath
        .AllowMultiSelect = False
        .Show
    End With

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ChosenFolder = FolderPath.SelectedItems(1)
GetDirectory = Mid(ChosenFolder, InStrRev(ChosenFolder, "\") + 1)
ChosenFile = Dir(ChosenFolder & "\*Output_Final*")

'Loop through files in the folder
Do While Len(ChosenFile) > 0

    'Open The Workbook
    Workbooks.Open Filename:=GetDirectory & "\" & ChosenFile

    'Format "Notes" Worksheet
    With Cells
        .ClearFormats
        .RowHeight = 14.4
        .ColumnWidth = 8.11
    End With

    LR = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A" & LR).ClearContents

    Range(Cells(1,1), Cells(1,1).End(xlToRight)).AutoFilter
    ActiveWorkbook.Worksheets("Notes").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Notes").AutoFilter.Sort.SortFields.Add _
        Key:=Range("A1"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Notes").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range(Cells(1,1), Cells(1,1).End(xlToRight)).AutoFilter


    'Format "Orders" Worksheet
    Sheets("Orders").Select
    With Cells
        .ClearFormats
        .RowHeight = 14.4
        .ColumnWidth = 8.11
    End With

    LastCell = Range("A1").SpecialCells(xlCellTypeLastCell).Address
    Columns("A:A").Select
    ActiveWorkbook.Worksheets("Orders").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Orders").Sort.SortFields.Add _
        Key:=Range("A1"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Orders").Sort
        .SetRange Range("A2:" & LastCell)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Delete remaining sheets
    Application.DisplayAlerts = False
        Sheets("C").Delete
        Sheets("D").Delete
        Sheets("E").Delete

    'Save file
    Sheets("Notes").Select

    strFileFullName = ActiveWorkbook.FullName
    SaveHere = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, "\")) & "FINAL\"
    NewName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & "_i2e"
    newFileFullPath = SaveHere & NewName & ".xlsx"

    ActiveWorkbook.SaveAs Filename:=newFileFullPath
    ActiveWorkbook.Close
    ChosenFile = Dir

Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.EnableAnimations = True
Application.DisplayStatusBar = True

MsgBox "Pre-Processing Complete for " & GetDirectory

End Sub

问题：

1）我可以在不实际打开和关闭excel文件的情况下处理这些文件吗？文件的打开和关闭是否会减慢该过程？

2）是否有更好的方式对排序过程进行编码？对于Worksheet（“ Notes”），列“ A”的所有行中都有数据，而在Worksheet（“ Orders”）中，列“ A”包含空的行间隙（行与数据之间的3-5个空行）。

谢谢您的帮助！

ahhn