Question

我使用以下代码从另一个工作簿导入多个工作表并进行一些处理。导入时间太长。任何人都可以提出更有效的导入方式吗？我是否应该查看源文件中的更多信息以进行复制？

Sub SKR_Import()
    On Error GoTo errorhandler
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim Sht As Worksheet
    Set wb1 = ActiveWorkbook
    Dim fd As FileDialog
    Dim filechosen As Integer
    Dim filename As String
    Dim i As Long
    Set fd = Application.FileDialog(msoFileDialogOpen)
    fd.AllowMultiSelect = True
    fd.Title = "Select Excel workbooks to import all sheets"
    filechosen = fd.Show
    If filechosen = -1 Then
        For i = 1 To fd.SelectedItems.Count
            Set wb2 = Workbooks.Open(fd.SelectedItems(i))
            For Each Sht In wb2.Sheets
                Sht.Activate
                ActiveSheet.Copy after:=wb1.Sheets(wb1.Sheets.Count)
            Next Sht
            wb2.Close SaveChanges:=False
        Next i
    End If
    wb1.Activate
    Application.ScreenUpdating = True
    Exit Sub
errorhandler:
    msgBox Error, vbCritical, "Error"
    wb2.Close SaveChanges:=False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Answer 1

您可以尝试使用wb2的复制方法（使用sheets）一次性复制它们，而不是在s的工作表上循环：

        Set wb2 = Workbooks.Open(fd.SelectedItems(i))
        ' For Each Sht In wb2.Sheets
        '     Sht.Activate
        '     ActiveSheet.Copy after:=wb1.Sheets(wb1.Sheets.Count)
        ' Next Sht
        wb2.Sheets.Copy after:=wb1.Sheets(wb1.Sheets.Count)
        wb2.Close SaveChanges:=False

这也将摆脱Activate声明，这不是必要的，但只是浪费了一段时间。

我似乎找不到其他方法来加速你的代码。

excel VBA导入多个工作表很慢

1 个答案: