【发布时间】：2016-07-29 23:50:26
【问题描述】：
我的代码可以打开四个工作簿，重新格式化数据，将其粘贴到当前工作簿中，然后关闭其他工作簿。
当我关闭其他工作簿时，我会收到一个 DisplayAlert，询问我是否要保存工作簿。我想停止出现 DisplayAlert。
微软推荐：
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
当我这样做时，Excel 崩溃了。
代码：
Function rngFoundLog(searchDate As Date)
Set rngSearchLog = Workbooks("Ecom KPI.xlsm").Worksheets("Daily Update Log").Range("A:A")
Set rngFoundLog = rngSearchLog.Find(What:=Sheet1.searchDate, LookIn:=xlValues, LookAt:=xlPart)
End Function
Function formatHourlies(fileName As String) As Object
Dim fullFileName As String
fullFileName = ActiveWorkbook.Path & "\Hourlies\" + fileName
Workbooks.Open fileName:=fullFileName
Workbooks(fileName).Worksheets("Top Line Metrics").Range("B9:H32").Copy
Workbooks(fileName).Worksheets("Top Line Metrics").Range("A34").PasteSpecial Transpose:=True
Workbooks(fileName).Worksheets("Top Line Metrics_0").Range("B9:H32").Copy
Workbooks(fileName).Worksheets("Top Line Metrics").Range("Y34").PasteSpecial Transpose:=True
Workbooks(fileName).Worksheets("Top Line Metrics_1").Range("N9:H32").Copy
Workbooks(fileName).Worksheets("Top Line Metrics").Range("AW34").PasteSpecial Transpose:=True
Workbooks(fileName).Worksheets("Top Line Metrics").Range("A34:BT40").Select
Selection.Replace What:="-", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Copy
End Function
Sub HourlyData()
Application.Calculation = xlManual
Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim proxyServer As String
Dim clientID As String
Dim report_period As String
Dim report_date As String
Dim searchDate As Date
Sheet1.proxyServer = Worksheets("Update Data").Range("H2").Value
Sheet1.proxyStatus = Worksheets("Update Data").Range("H1").Value
Sheet1.report_date = Worksheets("Update Data").Range("B2").Value
Sheet1.searchDate = Worksheets("Update Data").Range("B3").Value
Dim answer As Integer
answer = MsgBox("Do you want to import the data?", vbYesNo + vbQuestion, "Import Data?")
If answer = vbYes Then
Dim StartTime As Double
Dim MinutesElapsed As String
Dim dateRange As Range
StartTime = Timer
reportDate = Worksheets("Update Data").Range("B3").Value
searchDatev2 = reportDate - 7
Set rngSearch = Worksheets("Business Objects").Range("A:A")
Set rngFound = rngSearch.Find(What:=searchDatev2, LookIn:=xlValues, LookAt:=xlPart)
Dim fileName As String
fileName = "couk Hourlies.xlsx"
formatHourlies (fileName)
Workbooks("Ecom KPI.xlsm").Worksheets("Hourlies").Range("B" & rngFound.Row).PasteSpecial xlPasteValues
Workbooks(fileName).Close
fileName = "mcouk Hourlies.xlsx"
formatHourlies (fileName)
Workbooks("Ecom KPI.xlsm").Worksheets("Hourlies").Range("EQ" & rngFound.Row).PasteSpecial xlPasteValues
Workbooks(fileName).Close
fileName = "ie Hourlies.xlsx"
formatHourlies (fileName)
Workbooks("Ecom KPI.xlsm").Worksheets("Hourlies").Range("KF" & rngFound.Row).PasteSpecial xlPasteValues
Workbooks(fileName).Close
fileName = "mie Hourlies.xlsx"
formatHourlies (fileName)
Workbooks("Ecom KPI.xlsm").Worksheets("Hourlies").Range("PU" & rngFound.Row).PasteSpecial xlPasteValues
Workbooks(fileName).Close
Workbooks("Ecom KPI.xlsm").Worksheets("Daily Update Log").Range("T" & rngFoundLog(Sheet1.searchDate).Row).Value = Application.UserName
MinutesElapsed = format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "Data Import Completed in " & MinutesElapsed
Else
'do nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
'Application.DisplayAlerts = True
End Sub
【问题讨论】：
-
根据我的经验，在
Function中调用诸如Workbooks.Open之类的方法会使VBA 不稳定。考虑改为在Sub中调用这些方法。 -
@xidgel 你确定吗？除非您尝试将工作表中的函数作为 UDF 调用，否则它应该执行 Sub 所做的一切，等等。我在这里错过了什么吗？
-
@vacip 你说得对——谢谢你发现我的错误。
-
打开多个工作簿意味着您需要格外小心您的代码。最好打开一个工作簿，复制它，然后关闭它，然后粘贴并格式化。然后继续下一个工作簿。但无论如何，我有一个与你类似的设置，实际上可以说是一个实时提要。一个包含数千个单元格的 excel 文件，正在使用公式从其他文件中提取数据，并且只有相关信息会显示在提要上，所有信息均已格式化且整洁。我使用的代码只确保更新在 x 分钟内完成，并且排序和条件格式负责自动格式化