Rob*_*ati 2 excel vba replace excel-vba
我正在研究一个VBA宏,我遇到了一些非常奇怪的行为.
它可以正常工作Application.ScreenUpdating = True,甚至可以在屏幕更新关闭时使用VBA调试器逐步完成宏.
不幸的是,只是在屏幕更新关闭的情况下运行宏会导致Find函数在以下代码中失败:
Application.StatusBar = "Extracting data and updating tables..."
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open FileName:=Save_folder & "new_data.xls"
Workbooks("new_data.xls").Sheets("data").Range("B9:B39").Copy
Dim tempdate As Date, startCell As Range
tempdate = DateAdd("d", -1, Now)
tempdate = DateSerial(Year(tempdate), Month(tempdate), 1) 'Start of the month
Dim strdate As String
strdate = Format(tempdate, "Short Date")
Set startCell = ThisWorkbook.Sheets("Raw Data").Cells.Find(What:=CDate(strdate), After:=ThisWorkbook.Sheets("Raw Data").Range("A1"), LookIn:=xlFormulas _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If startCell Is Nothing Then
MsgBox "Couldn't find a date equal to the start of yesterday's month."
Exit Sub
Else
startCell.Offset(0, 1).PasteSpecial xlPasteValues, Transpose:=False
End If
Run Code Online (Sandbox Code Playgroud)
在调用之上添加此简短代码段以Cells.Find解决问题:
'Wait one second, to appease the Excel object creation gods
Application.StatusBar = "Wait one second..."
Application.Wait Now + TimeValue("00:00:01")
Application.StatusBar = "Pasting values..."
Run Code Online (Sandbox Code Playgroud)
投掷MsgBox或提示等也可以Find成功.
我的问题是,为什么我要等?
我无法产生这种行为.见截图
Sub Sample()
Dim tempdate As Date, startCell As Range
Dim strdate As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
tempdate = DateAdd("d", -1, Now)
tempdate = DateSerial(Year(tempdate), Month(tempdate), 1) 'Start of the month
strdate = Format(tempdate, "Short Date")
Set startCell = ThisWorkbook.Sheets("Raw Data").Cells.Find(What:=CDate(strdate), LookIn:=xlFormulas _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If startCell Is Nothing Then
MsgBox "Couldn't find a date equal to the start of yesterday's month."
Else
MsgBox "Found"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Run Code Online (Sandbox Code Playgroud)
快照

更新:
如果您的代码中发生了很多事情,那么请使用DoEvents以便代码将控制权传递给操作系统,以便操作系统可以处理其他事件.