performance - 添加的代码显着减慢了处理时间
问题描述
我将这段代码拼接在一起。它从工作簿中获取工作表,将它们作为单独的工作簿保存在新文件夹中,然后通过电子邮件将它们发送给 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
解决方案
推荐阅读
- python - 分解 SWIG Python 接口——容器创建命名空间冲突
- reactjs - 有没有办法通过相对链接“突破”反应应用程序
- c++11 - C ++ - 读取文件后无法以二进制模式用单个字节覆盖文件(Windows 10)
- c# - taglib-sharp 不标记 mkv 文件
- python - Python中的平滑/噪声过滤数据
- c# - 如何在 C# 的 Linq 查询中使用 partition by 在后续行中添加列值?
- html - 表格 tr 边框宽度 100%
- nock - Nock 固定装置:匹配时忽略请求主体
- amazon-web-services - Cloudformation 复杂参数文件
- python - 带有 Raspberry Pi Zero 的 AlphaBot2 无法正常工作