Bagaimana cara menjeda untuk jangka waktu tertentu? (Excel / VBA)

Saya memiliki lembar kerja Excel yang memiliki makro berikut. Saya ingin mengulanginya setiap detik tetapi gagal jika saya dapat menemukan fungsi untuk melakukan itu. Apa tidak mungkin?

Sub Macro1()
'
' Macro1 Macro
'
Do
    Calculate
    'Here I want to wait for one second

Loop
End Sub

Gunakan metode Tunggu :

Application.Wait Now + #0:00:01#

atau (untuk Excel 2010 dan yang lebih baru):

Application.Wait Now + #12:00:01 AM#

Tambahkan ini ke modul Anda

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Atau, untuk penggunaan sistem 64-bit:

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Sebut saja di makro Anda seperti ini:

Sub Macro1()
'
' Macro1 Macro
'
Do
    Calculate
    Sleep (1000) ' delay 1 second

Loop
End Sub

daripada menggunakan:

Application.Wait(Now + #0:00:01#)

saya lebih memilih:

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

karena jauh lebih mudah dibaca setelahnya.

ini bekerja dengan sempurna untuk saya. masukkan kode apa pun sebelum atau setelah loop "lakukan hingga". Dalam kasus Anda, letakkan 5 baris (time1 = & time2 = & loop "lakukan sampai") di akhir di dalam loop do Anda

sub whatever()
Dim time1, time2

time1 = Now
time2 = Now + TimeValue("0:00:01")
    Do Until time1 >= time2
        DoEvents
        time1 = Now()
    Loop

End sub

Deklarasi untuk Tidur di kernel32.dll tidak akan berfungsi di Excel 64-bit. Ini akan menjadi sedikit lebih umum:

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Hanya versi kode clemo yang dibersihkan - berfungsi di Access, yang tidak memiliki fungsi Application.Wait.

Public Sub Pause(sngSecs As Single)
    Dim sngEnd As Single
    sngEnd = Timer + sngSecs
    While Timer < sngEnd
        DoEvents
    Wend
End Sub

Public Sub TestPause()
    Pause 1
    MsgBox "done"
End Sub

Sebagian besar solusi yang disajikan menggunakan Application.Wait, yang tidak memperhitungkan waktu (milidetik) yang telah berlalu sejak penghitungan detik saat ini dimulai, sehingga solusi tersebut memiliki ketidaktepatan intrinsik hingga 1 detik .

Pendekatan Timer adalah solusi terbaik , tetapi Anda harus memperhitungkan reset pada tengah malam, jadi berikut adalah metode Tidur yang sangat tepat menggunakan Timer:

'You can use integer (1 for 1 second) or single (1.5 for 1 and a half second)
Public Sub Sleep(vSeconds As Variant)
    Dim t0 As Single, t1 As Single
    t0 = Timer
    Do
        t1 = Timer
        If t1 < t0 Then t1 = t1 + 86400 'Timer overflows at midnight
        DoEvents    'optional, to avoid excel freeze while sleeping
    Loop Until t1 - t0 >= vSeconds
End Sub

GUNAKAN INI UNTUK MENGUJI FUNGSI TIDUR: (buka jendela debug Segera: CTRL + G)

Sub testSleep()
    t0 = Timer
    Debug.Print "Time before sleep:"; t0   'Timer format is in seconds since midnight

    Sleep (1.5)

    Debug.Print "Time after sleep:"; Timer
    Debug.Print "Slept for:"; Timer - t0; "seconds"

End Sub

Application.Wait Second(Now) + 1

Function Delay(ByVal T As Integer)
    'Function can be used to introduce a delay of up to 99 seconds
    'Call Function ex:  Delay 2 {introduces a 2 second delay before execution of code resumes}
        strT = Mid((100 + T), 2, 2)
            strSecsDelay = "00:00:" & strT
    Application.Wait (Now + TimeValue(strSecsDelay))
End Function

Berikut ini alternatif untuk tidur:

Sub TDelay(delay As Long)
Dim n As Long
For n = 1 To delay
DoEvents
Next n
End Sub

Dalam kode berikut saya membuat efek "cahaya" berkedip pada tombol putar untuk mengarahkan pengguna ke sana jika mereka "mengalami masalah", menggunakan "tidur 1000" di loop mengakibatkan tidak ada kedipan yang terlihat, tetapi loop berfungsi dengan baik.

Sub SpinFocus()
Dim i As Long
For i = 1 To 3   '3 blinks
Worksheets(2).Shapes("SpinGlow").ZOrder (msoBringToFront)
TDelay (10000)   'this makes the glow stay lit longer than not, looks nice.
Worksheets(2).Shapes("SpinGlow").ZOrder (msoSendBackward)
TDelay (100)
Next i
End Sub

Saya membuat ini untuk menjawab masalah:

Sub goTIMER(NumOfSeconds As Long) 'in (seconds) as:  call gotimer (1)  'seconds
  Application.Wait now + NumOfSeconds / 86400#
  'Application.Wait (Now + TimeValue("0:00:05"))  'other
  Application.EnableEvents = True       'EVENTS
End Sub

Saya biasanya menggunakan fungsi Timer untuk menghentikan aplikasi. Masukkan kode ini ke milik Anda

T0 = Timer
Do
    Delay = Timer - T0
Loop Until Delay >= 1 'Change this value to pause time for a certain amount of seconds

Fungsi Tunggu dan Tidur mengunci Excel dan Anda tidak dapat melakukan apa pun hingga penundaan selesai. Di sisi lain, penundaan loop tidak memberi Anda waktu yang tepat untuk menunggu.

Jadi, saya telah membuat solusi ini dengan menggabungkan sedikit dari kedua konsep tersebut. Ini berulang sampai waktu yang Anda inginkan.

Private Sub Waste10Sec()
   target = (Now + TimeValue("0:00:10"))
   Do
       DoEvents 'keeps excel running other stuff
   Loop Until Now >= target
End Sub

Anda hanya perlu menelepon Waste10Sec jika Anda membutuhkan penundaan

Coba ini :

Threading.thread.sleep(1000)

Anda dapat menggunakan Application.wait now + timevalue ("00:00:01") atau Application.wait now + timeserial (0,0,1)