將工作簿 Sheet1 中的數據復制到主工作表

Question

我有宏，它將數據從選定工作簿的 Sheet1 復制到最后一行的主工作簿的 Sheet1 中。 對於少量文件，它很快，但是當我 select 更多文件（比如 20 個）時，它會中斷並且 excel 甚至崩潰。 由於我已經在使用 Application.EnableEvents 和 ScreenUpdating，如何提高效率？

Sub Copy_From_Workbooks()

    Dim numberOfFilesChosen, i As Integer
    Dim tempFileDialog As FileDialog
    Dim sourceWorkbook As Workbook
    Dim loLastRow As Long

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

    tempFileDialog.Filters.Add "Excel Files", "*.xlsx?", 1
    tempFileDialog.AllowMultiSelect = True
    numberOfFilesChosen = tempFileDialog.Show

    For i = 1 To tempFileDialog.SelectedItems.Count
        Workbooks.Open tempFileDialog.SelectedItems(i)
        Set sourceWorkbook = ActiveWorkbook
        If ActiveWorkbook.Worksheets(1).Range("A1") <> "" Then
            With ActiveWorkbook.Worksheets(1)
                With .Cells(1).CurrentRegion
                    .Offset(1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy
                End With
            End With
        End If
        With ThisWorkbook.Worksheets("Sheet1")
            loLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Range("A" & loLastRow).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            'ThisWorkbook.Save
        End With
        sourceWorkbook.Close
    Next i
    Application.EnableEvents = False
    Application.ScreenUpdating = True
End Sub

Answer 1

1. 您為源工作簿設置了一個變量，但不使用它。
2. 使用With blocks ，這樣您就不會一遍又一遍地調用引用 object。

3. 直接寫入值，而不是使用較慢的復制/粘貼。

    For i = 1 To tempFileDialog.SelectedItems.Count Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i)) With sourceWorkbook.Worksheets(1) If.Range("A1") <> "" Then Dim valRange as Range With.Cells(1).CurrentRegion Set valRange =.Offset(1).Resize(.Rows.Count - 1, .Columns.Count - 1) End With End With End If With ThisWorkbook.Worksheets("Sheet1") loLastRow =.Cells(Rows.Count, 1).End(xlUp).Row + 1.Range("A" & loLastRow).Resize(valRange.Rows.Count,valRange.Columns.Count).Value = valRange.Value 'ThisWorkbook.Save End With sourceWorkbook.Close Next i