добавленный код значительно замедляет время обработки - PullRequest
0 голосов
/ 06 июня 2018

Я работал над этим кодом, склеивая элементы.Он берет рабочие листы из рабочей книги, сохраняет их как отдельные рабочие книги в новой папке, а затем отправляет их по электронной почте руководителям для их действий.Я написал это вслепую, не зная, как структурирована рабочая тетрадь.Затем я обнаружил, что у рабочей книги (это файл с ограниченным доступом) есть первые 4 рабочих листа, которые мне нужно игнорировать.Я добавил еще один цикл if, чтобы игнорировать таблицы, содержащие строку «IGNORE» в ячейке A2.Это работало так быстро, прежде чем я добавил это, если утверждение сейчас, кажется, это занимает гораздо больше времени.Боюсь, что это будет неоправданно медленно на рабочей книге, на которой я собираюсь ее реализовать (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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...