首页 > 解决方案 > 添加的代码显着减慢了处理时间

问题描述

我将这段代码拼接在一起。它从工作簿中获取工作表,将它们作为单独的工作簿保存在新文件夹中,然后通过电子邮件将它们发送给 PM 以供他们采取行动。我盲目地写了它,不知道工作簿的结构。然后我发现了工作簿(它是一个受限访问文件),其中包含我需要忽略的前 4 个工作表。我添加了另一个 if 循环来忽略单元格 A2 中包含字符串“IGNORE”的工作表。在我添加这个 if 语句之前它运行得如此之快,现在它似乎需要更长的时间。我担心它会在我将要实施的工作簿(20 个工作表)上变得异常缓慢。我想我会在调试模式下观看它,但任何帮助将不胜感激。这是代码:

Sub SplitWorkbook()
'TMP June 5, 2018 Export and save worksheets as new Workbook in a new folder
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
'TMP June 5, 2018 added following dims for auto email generator submodule
Dim oApp As Object
Dim oMail As Object
Dim eAdd As Object
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
      xWs.Copy
    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        Select Case xWb.FileFormat
            Case 51:
                FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If Application.ActiveWorkbook.HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56:
                FileExtStr = ".xls": FileFormatNum = 56
            Case Else:
                FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
    End If
  Set eAdd = ActiveSheet.Range("A2")
  If eAdd <> "IGNORE" Then
  xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
        'TMP June 5,2018 Added submodule to create and show the Outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    Set eAdd = ActiveSheet.Range("A1")
    With oMail
        'selects the to from A1
        .to = ActiveSheet.Range("A1")
        'Sets the subject
        .Subject = "Your hammer sheet is attached"
        'Creates the body of the email
        .body = ActiveSheet.Range("A2") & vbNewLine & vbNewLine & _
          "Here is your hammer sheet to fill out and send back within 2 days" & vbNewLine & vbNewLine & "Thanks a lot," & vbNewLine & vbNewLine & "Mounir Samara"
        .Attachments.Add xFile
        .Display
    End With
    Application.ActiveWorkbook.Close False
 End If ''IGNORE' if loop
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

标签: performanceif-statement

解决方案


推荐阅读