Question

我有一个代码，可以从我们选择的任意数量的工作簿中加载数据并加载到当前工作簿中。孤立地工作非常好（在我不执行任何其他任务的文件中）。但是，当我在一个大文件中使用此代码时，我在多个数组函数中使用（引用）了复制的数据，而加载1-2个文件则需要花费二十多分钟，而之前的秒数则为二十。

是否可能由于链接到具有功能的其他选项卡而使其速度变慢？我错过了什么吗？任何帮助将不胜感激。

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.Calculation = xlCalculationManual

Number = 0
IT = 0
Set thisWb = ActiveWorkbook
Set ws = thisWb.Sheets("CF")
thisWb.Sheets("CF").Select
ws.Range(ws.Cells(2, 1), ws.Cells(100000, 42)).ClearContents

Do
    files = Application.GetOpenFilename(filefilter:="Excel workbooks (*.csv*),*.csv*", Title:="Select files to import", MultiSelect:=True)
    If Not IsArray(files) Then Exit Sub 'Cancel must have been clicked
    If UBound(files) < 1 Then
        MsgBox "You have not selected any file. Please select files."
        End If
Loop Until UBound(files) > 0

 Number = UBound(files)
 N = Number + N

 For IT = 1 To UBound(files)
    Workbooks.Open files(IT)
    With ActiveWorkbook
        Application.CutCopyMode = False
        Set wk = ActiveWorkbook.ActiveSheet
        .ActiveSheet.Range("A2:AP10000").Copy
        'LastRow = wk.Cells(Rows.Count, "A").End(xlUp).Row
        thisWb.Activate
        ws.Select
        LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
        Range("A" & LastRow).Select
        Set Rng = ws.Range("A" & LastRow)
        Rng.PasteSpecial xlPasteValues
        LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
        Application.CutCopyMode = False
        .Close False
   End With
Next

任何可以使此代码运行更快的功能（例如在一分钟内加载3-4个小文件）都是完美的。

Answer 1

这里是一个如何创建变量和对象以跟踪所使用的工作簿，工作表和数据源的示例。还要注意，我正在将数据从Range复制到基于内存的数组中，以存储大量的 speed 。

请注意，强烈建议始终使用Option Explicit。

Option Explicit

Sub test()
    Dim number As Long
    Dim it As Long
    number = 0
    it = 0

    Dim thisWB As Workbook
    Dim ws As Worksheet
    Set thisWB = ActiveWorkbook
    Set ws = thisWB.Sheets("CF")

    '--- clear the worksheet
    ws.Cells.Clear

    Dim files As Variant
    Do
        files = Application.GetOpenFilename(filefilter:="Excel workbooks (*.csv*),*.csv*", _
                                            Title:="Select files to import", _
                                            MultiSelect:=True)
        If Not IsArray(files) Then Exit Sub      'Cancel must have been clicked
        If UBound(files) < 1 Then
            MsgBox "You have not selected any file. Please select files."
        End If
    Loop Until UBound(files) > 0

    Dim n As Long
    number = UBound(files)

    Dim csvWB As Workbook
    Dim csvWS As Worksheet
    Dim csvData As Variant
    Dim dataRange As Range
    Dim lastRow As Long
    Dim rng As Range
    For it = 1 To UBound(files)
        Set csvWB = Workbooks.Open(files(it))
        With csvWB
            Set csvWS = csvWB.Sheets(1)
            csvData = csvWS.UsedRange                   'copy to memory-based array
            'Set csvData = csvWS.Range("A2:AP10000")    'copy to memory-based array
            Set dataRange = ws.Range("A1").Resize(UBound(csvData, 1), UBound(csvData, 2))
            dataRange.Value = csvData
            .Close False
        End With
    Next
End Sub

与其他文件相比，在一个文件中将数据从工作簿复制到当前工作簿的速度非常慢

1 个答案: