可以加快导入过程吗？目前 500K 行数据需要 4 分 45 秒

Posted 2023-05-07

【中文标题】可以加快导入过程吗？目前 500K 行数据需要 4 分 45 秒

【英文标题】：Possible to speed up import process? Currently 500K rows of data takes 4 min and 45 sec

【发布时间】：2015-10-23 11:15:33

【问题描述】：

我正在将工作簿中的特定工作表（大约 500K 行）导入到我正在使用的当前工作簿中。通过在再次导入之前删除当前工作表，导入连续工作正常，但它真的很慢。

我尝试添加：

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

从link 到我的代码，但导入时间并没有真正改善。

关于如何大幅缩短导入时间的任何提示？

这是我的代码：

Public filespec As Variant

Sub import_click()
    filespec = Application.GetOpenFilename()

    If filespec = False Then Exit Sub

    Call deletedatasheet
    Call import

    MsgBox "Data imported", vbInformation

End Sub

Private Sub import()

Dim wsMaster As Worksheet
Dim rd As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

    If wsMaster Is Nothing Then
        ThisWorkbook.Sheets.Add
        Set wsMaster = ActiveSheet
        Set rd = wsMaster.Range("A1")
        wsMaster.Name = "Reviewed"
        Set wb = Workbooks.Open(Filename:=filespec)
        Sheets("Reviewed").Activate
        Cells.Copy rd
        wb.Close
    End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Sub deletedatasheet()
    Dim ws As Worksheet

    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = "Reviewed" Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

【参考方案1】：

尝试仅复制完整 100 万多行和列的已使用范围 insetad（未经测试）：

Option Explicit

Public filespec As Variant

Sub import_click()
    filespec = Application.GetOpenFilename()
    If filespec = False Then Exit Sub

    Call deletedatasheet
    Call import
    MsgBox "Data imported", vbInformation
End Sub

---

Private Sub importSheet()
    Dim wsMaster As Worksheet
    Dim rd As Range, wb As Workbook

    xlEnabled False
    If wsMaster Is Nothing Then
        ThisWorkbook.Sheets.Add
        Set wsMaster = ActiveSheet
        wsMaster.Name = "Reviewed"
        Set rd = wsMaster.Range("A1")
        wsMaster.EnableCalculation = False

        Set wb = Workbooks.Open(Filename:=filespec)
            With wb.Sheets("Reviewed")
                .EnableCalculation = False
                .UsedRange.Copy
                rd.PasteSpecial xlPasteColumnWidths
                rd.PasteSpecial xlPasteAll
                .EnableCalculation = True
            End With
        wsMaster.EnableCalculation = True
        wb.Close
    End If
    xlEnabled
End Sub

Private Sub xlEnabled(Optional ByVal opt As Boolean = True)
    With Application
        .EnableEvents = opt
        .ScreenUpdating = opt
        .DisplayAlerts = opt
        .Calculation = IIf(opt, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

【讨论】：

是的，结合import_click() - 我也将它包含在我的答案中

【参考方案2】：

试试这个：

Public filespec As Variant, file As String
Sub import_click()

Dim ws As Worksheet

filespec = Application.GetOpenFilename()
file = Dir(filespec)
If filespec = False Then Exit Sub
file = Dir(filespec)
If Evaluate("ISREF(Reviewed!A1)") Then
    Application.DisplayAlerts = False
    Sheets("Reviewed").Delete
    Application.DisplayAlerts = True
End If
Call import
MsgBox "Data imported", vbInformation

End Sub

Private Sub import()

Dim wsMaster As Worksheet, lr As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ThisWorkbook.Sheets.Add().Name = "Reviewed"
Application.Workbooks.Open Filename:=filespec
lr = Workbooks(file).Sheets("Reviewed").Range("A" & Rows.Count).End(xlUp).Row
ThisWorkbook.Sheets("Reviewed").Range("A1:Z" & lr).Value = Workbooks(file).Sheets("Reviewed").Range("A1:Z" & lr).Value
Workbooks(file).Close

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

【讨论】：

大约 3 分钟后，我收到以下错误消息“溢出”并重定向到“lr = Workbooks(file).Sheets("Reviewed").Range("A" & Rows.Count ).End(xlUp).Row"

你有什么版本的Office？

@Saud 是的，我尝试生成具有 500k 行和 50 列的工作表，然后使用我的代码，我得到了同样的错误。我猜 Excel 并不是处理如此大量数据的最佳工具，尽管它的限制为 1,048,576 行 x 16,384 列。