在VBA代码运行时使用Excel电子表格

时间:2016-04-10 12:44:11

标签: excel vba excel-vba

我得到了一个简单的代码,如果值为lass然后X等待一个小时,则继续循环 - 基本上代码需要运行一天。

问题是,当代码在等待行中时,我根本不能使用excel。 有办法解决这个问题吗? 我添加了部分代码

    For i = 1 To 3
Set OutMail = OutApp.createitem(0)
LastRefHour = Cells(2, 1).Value
HourNow = Hour(Now())
Set rng = Sheets("Sheet1").Range("D2:G9").SpecialCells(xlCellTypeVisible)

If (LastRefHour < HourNow) Then

    ActiveWorkbook.Connections("Monitor-Test").Refresh
    Application.CalculateUntilAsyncQueriesDone
    If Not Application.CalculationState = xlDone Then
    DoEvents
    End If

Cells(1, 1).Copy
Cells(2, 1).PasteSpecial xlPasteValues

Else:

    Application.Wait (Now + TimeValue("00:59:00"))


End If

1 个答案:

答案 0 :(得分:2)

我建议使用Timer function (MSDN)

以下是如何使用它:

Option Explicit

Sub RunCodeInIntervalMode()
Dim StartTime As Single, FinishTime As Single
'i decided to set below variable for short interval of time, 
'because this is only an example
Const WaitTime As Integer = 5 'in second
Dim i As Integer 'counter

'clear entire range
ThisWorkbook.Worksheets(1).Cells.ClearContents

'define finish time
FinishTime = Timer + 30
Do
    'define start time
    StartTime = Timer
    'increase counter
    i = i + 1
    'run procedure
    DisplayTime i, StartTime, FinishTime
    'enable to work in Worksheet in between next run
    Do While Timer < StartTime + WaitTime
        DoEvents
    Loop
Loop While Timer < FinishTime

End Sub

''let's say below procedure is your procedure
Sub DisplayTime(ByVal step As Integer, ByVal currTime As Single, ByVal finTime As Single)

    With ThisWorkbook.Worksheets(1)
        .Range("A1") = step
        .Range("B1") = currTime
        .Range("C1") = finTime
    End With
End Sub

我希望你现在知道如何实现这一目标。