Question

我正在将工作簿中的特定工作表（大约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

Answer 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

Answer 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

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

2 个答案: