Jak zatrzymać się na określony czas? (Excel / VBA)

103

Mam arkusz programu Excel zawierający następujące makro. Chciałbym zapętlać to co sekundę, ale chciałbym znaleźć funkcję, która to zrobi. Czy to nie jest możliwe?

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

Loop
End Sub
Keng
źródło

Odpowiedzi:

129

Użyj metody Wait :

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

lub (dla programu Excel 2010 i nowszych):

Application.Wait Now + #12:00:01 AM#
Ben S.
źródło
Nie jestem do końca pewien, co masz na myśli, ale spekuluję, że chcesz, DoEventsjak pokazano
Ryan Shannon
3
@Benoit i @Keng, możesz umieścić 1 sekundę bezpośrednio, unikając przekształcania tekstu do tej pory. Dla mnie jest czystsze: Application.Wait(Now + #0:00:01#)Pozdrawiam!
A.Sommerh
29
Ten format nie działał w programie Excel 2010. Działa to jednak:Application.Wait (Now + TimeValue("0:00:01"))
ZX9
1
DateAdd ("s", 1, Now) działa właściwie. I można je uogólniać na dowolną długą liczbę sekund: DateAdd ("s", nSec, Now) bez użycia literału czasu. Aby przespać mniej niż 1 sekundę, użyj funkcji Sleep API w kernel32
Andrew Dennison,
1
@ ZX9 timevalue ("00:00:01") = 0,0000115740 ... Więc Application.wait (teraz + 0,00001) to około sekundy. Lubię używać Application.wait(now + 1e-5)przez sekundę, Application.wait(now + 0.5e-5)przez pół sekundy itd.
Some_Guy
61

Dodaj to do swojego modułu

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

Lub w przypadku systemów 64-bitowych użyj:

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

Nazwij to w swoim makrze w ten sposób:

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

Loop
End Sub
Buggabill
źródło
1
Dlaczego nie skorzystać w tym celu z metody VBA, zamiast korzystać z kernel32.dll?
Ben S
10
Użyłem tej metody, ponieważ można ją przenosić między różnymi produktami biurowymi, takimi jak Access, i nie jest specyficzna dla programu Excel.
Buggabill
Jest też inna aplikacja VBA (ERS), której używam, która ma bardzo ograniczony podzbiór języka.
Buggabill
18
+1, ponieważ Sleep()pozwala określić czas oczekiwania poniżej 1 sekundy. Application.Waitjest czasami zbyt ziarnisty.
BradC
2
@JulianKnight:Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Vegard,
42

zamiast używać:

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

wolę:

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

ponieważ później jest o wiele łatwiejsze do odczytania.

Achaibou Karim
źródło
7
I to działa, podczas gdy w Office 2013 format # 0: 0: 1 # jest konwertowany na 1 sekundę po północy.
Julian Knight,
1
OSTRZEŻENIE: Wszystkie rozwiązania korzystające z opcji „Aplikacja.Wait” mają niedokładność wynoszącą 1 sekundę. Ta metoda nie uwzględnia milisekund, które już upłynęły od rozpoczęcia bieżącej sekundy ... Na przykład, jeśli pozostała tylko 1 milisekunda do zmiany sekund czasu, będziesz spać tylko przez 1 milisekundę. Po prostu porównujesz 2 zaokrąglone liczby zamiast czekać 1 sekundę!
cyberponk
18

to działa bez zarzutu dla mnie. wstaw dowolny kod przed lub po pętli „do aż”. W twoim przypadku umieść 5 wierszy (pętla time1 = & time2 = & "do till") na końcu wewnątrz pętli do

sub whatever()
Dim time1, time2

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

End sub
clemo
źródło
2
Najbardziej podoba mi się to rozwiązanie, ponieważ nie chciałem zatrzymywać kolejki wiadomości.
Daniel Fuchs
To rozwiązanie jest precyzyjne i nie wymaga deklaracji funkcji sleep-API. Kiedyś przechowywałem czas w podwójnych wartościach i zamiast tego używałem mikrosekund z tym samym wynikiem.
DrMarbuse
To rozwiązanie działa lepiej niż podobne rozwiązania poniżej, które używają, Timerponieważ Timerpodejście kończy się niepowodzeniem tuż przed północą.
vknowles
1
To rozwiązanie nie jest precyzyjne, nie bierze pod uwagę milisekund, które już upłynęły od aktualnego czasu ... Na przykład, jeśli pozostała tylko 1 milisekunda do zmiany sekund Teraz, będziesz spać tylko przez 1 milisekundę.
cyberponk
kiedy inne rozwiązania zajmowały dużo czasu w przypadku makra VBA nie opartego na MS Office, ten działał idealnie - dzięki!
ciekawy
12

Deklaracja uśpienia w kernel32.dll nie będzie działać w 64-bitowym programie Excel. To byłoby trochę bardziej ogólne:

#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
dbuskirk
źródło
2
Nie można skompilować w Office 2013. Narzędzie do sprawdzania błędów w VBA dla Office 2013 wydaje się ignorować instrukcje kompilatora.
Julian Knight,
2
Kompiluje się dobrze w pakiecie Office 2013.
Jon Peltier
Większość ludzi zgadza się, że Win64 / VBA7 dwMilliseconds to Long, a nie LongPtr. Excel VBA ukrywa takie błędy, wykonując korektę stosu po wywołaniach zewnętrznych, ale takie błędy powodują awarię większości wersji Open Office
David
6

Po prostu wyczyszczona wersja kodu Clemo - działa w programie Access, który nie ma funkcji 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
Brian Burns
źródło
2
Jeśli Timerpodaje liczbę sekund od północy, to podejście nie powiedzie się, jeśli zostanie wykonane tuż przed północą (czyli np. sngEnd> = 86 400). O północy Timerresetuje się do 0 i pozostaje mniej niż na sngEndzawsze.
vknowles
PS Kod z @clemo powyżej działa o każdej porze dnia.
vknowles
@vknowles, to, co powiedziałeś, jest absolutnie prawdziwe. A także można skompensować w poniższej metodzie. Ponieważ ta metoda obsługuje milisekundy, myślę, że jest to bezpieczny zakład. `` Public Sub Sleep (sngSecs As Single) Dim sngEnd As Single sngEnd = Timer + (sngSecs / 1000) While Timer <sngEnd DoEvents If (sngEnd - Timer)> 50000 Then sngEnd = sngEnd - 86400 End If Wend End Sub `` '' `
PravyNandas
5

Większość z przedstawionych rozwiązań korzysta z Application.Wait, który nie uwzględnia czasu (milisekund), który już upłynął od rozpoczęcia bieżącego drugiego liczenia, więc mają one wewnętrzną niedokładność do 1 sekundy .

Podejście Timer jest najlepszym rozwiązaniem , ale musisz wziąć pod uwagę reset o północy, więc tutaj jest bardzo precyzyjna metoda uśpienia za pomocą Timera:

'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

UŻYJ TEGO DO PRZETESTOWANIA KAŻDEJ FUNKCJI UŚPIENIA: (otwórz okno debugowania Bezpośrednie okno: 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
cyberponk
źródło
3

Application.Wait Second(Now) + 1

gt
źródło
OSTRZEŻENIE: Wszystkie rozwiązania korzystające z opcji „Aplikacja.Wait” mają niedokładność wynoszącą 1 sekundę. Ta metoda nie uwzględnia milisekund, które już upłynęły od rozpoczęcia bieżącej sekundy ... Na przykład, jeśli pozostała tylko 1 milisekunda do zmiany sekund czasu, będziesz spać tylko przez 1 milisekundę. Po prostu porównujesz 2 zaokrąglone liczby zamiast czekać 1 sekundę!
cyberponk
2
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
ITI
źródło
1
OSTRZEŻENIE: Wszystkie rozwiązania korzystające z opcji „Aplikacja.Wait” mają niedokładność wynoszącą 1 sekundę. Ta metoda nie uwzględnia milisekund, które już upłynęły od rozpoczęcia bieżącej sekundy ... Na przykład, jeśli pozostała tylko 1 milisekunda do zmiany sekund czasu, będziesz spać tylko przez 1 milisekundę. Po prostu porównujesz 2 zaokrąglone liczby zamiast czekać 1 sekundę!
cyberponk
2

Oto alternatywa dla snu:

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

W poniższym kodzie wykonuję efekt "poświaty" migający na przycisku obracania, aby skierować użytkowników do niego, jeśli mają "problemy", użycie "uśpienia 1000" w pętli nie spowodowało widocznego mrugania, ale pętla działa świetnie.

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
Reverus
źródło
1

Wykonałem to, aby rozwiązać problem:

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
dave
źródło
OSTRZEŻENIE: Wszystkie rozwiązania korzystające z opcji „Aplikacja.Wait” mają niedokładność wynoszącą 1 sekundę. Ta metoda nie uwzględnia milisekund, które już upłynęły od rozpoczęcia bieżącej sekundy ... Na przykład, jeśli pozostała tylko 1 milisekunda do zmiany sekund czasu, będziesz spać tylko przez 1 milisekundę. Po prostu porównujesz 2 zaokrąglone liczby zamiast czekać 1 sekundę!
cyberponk
1

Zwykle używam funkcji Timer, aby wstrzymać aplikację. Wstaw ten kod do swojego

T0 = Timer
Do
    Delay = Timer - T0
Loop Until Delay >= 1 'Change this value to pause time for a certain amount of seconds
Anastasiya-Romanova 秀
źródło
3
Jeśli Timerpodaje liczbę sekund od północy, to podejście nie powiedzie się, jeśli zostanie wykonane tuż przed północą (tj. Takie, które T0jest mniejsze niż liczba sekund opóźnienia od północy). O północy Timerresetuje się do 0 przed osiągnięciem limitu opóźnienia. Delaynigdy nie osiąga limitu opóźnienia, więc pętla działa w nieskończoność.
vknowles
Ponieważ Timer generuje wartości niecałkowite, powinieneś użyć Loop Until Delay >= 1, w przeciwnym razie ryzykujesz przekroczenie 1 i nigdy nie wychodzisz z pętli.
Jon Peltier,
1

Funkcje czekania i uśpienia blokują program Excel i nie można zrobić nic innego, dopóki opóźnienie się nie skończy. Z drugiej strony opóźnienia pętli nie dają dokładnego czasu oczekiwania.

Więc zrobiłem to obejście, łącząc trochę obu koncepcji. Powtarza się do momentu, w którym chcesz.

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

Wystarczy zadzwonić do Waste10Sec, jeśli potrzebujesz opóźnienia

Maycow Moura
źródło
0

Spróbuj tego :

Threading.thread.sleep(1000)
DEV
źródło
0

Możesz użyć Application.wait now + timevalue ("00:00:01") lub Application.wait now + timeserial (0,0,1)

Tuan Nguyen
źródło