VBAで72時間タイマーがオーバーフローします…

Question

VBA初心者です。会社で最大７２時間のカウントダウンタイマーを作ってと言われ、
時間と分をセル入力して起動するように作ってみましたが、何故か９時間以上に設定するとオーバーフローが発生します…。ネットから対策方法を探してInteger、Longの長整数型で宣言してみましたが、うまくいきません。
Format、Timeserial関数あたりが問題？だとは思いますが、かといって対策方法がわかりません。
ちなみに時間・分・秒表示は必須です。どなたかわかる方ご教授下さい！

以下構文になります。

Sub timer()
  Dim limit As Date, cnt_d As Double
 
  limit = DateAdd("n", Range("D4"), Time) 
  limit = DateAdd("h", Range("B4"), Time)
 
  UserForm1.Show vbModeless 
  UserForm1.Repaint 
 
  Do
    cnt_d = DateDiff("s", Time, limit) 

    UserForm1.TextBox2 = Format(TimeSerial(0, 0, cnt_d), "hh:nn:ss") 
    If UserForm1.TextBox2 = "00:00:00" Then Exit Do
         
    DoEvents
  Loop
 
End Sub

tatsu99 · Accepted Answer

＞試してみましたが、オーバーフローは無いものの表示が正しくありません…何故か0表示のままになります。

＞まれに61分表示にもなります。なぜでしょう？？
いくつか、原因が考えられますが、下記の点を修正しました。
１．アクティブシートのB4,D4を最初のタイマー値にしているが、それだと、アクティブシートが変わる可能性があるので
明示的にシートを指定するようにした。（シート名を"Sheet1"にしています。あなたの環境にあわせてシート名を変えてください）
又、あなたが提示されたコードでは、D4（分）は、無視されるので、この値も組み込むようにしました。
B4（時）の最大値は100時間にしています。B4,D4で不正な値の場合は、エラーにするようにしました。
２．Time関数は、翌日になると値が０に戻るので、Now関数に変えました。
３．完了後に"timeout"をメッセージボックスにだしています。不要なら削除してください。

以下のようにしてください。
----------------------------------------------------
Sub timer()
Dim t_hh As Long
Dim t_nn As Long
Dim t_ss As Long
Dim err As Boolean
Dim ws As Worksheet
Dim t1 As Variant
Dim t2 As Variant
Dim t_diff As Double
Dim diff As Long
Set ws = Worksheets("Sheet1")
err = False
t_hh = ws.Range("B4").Value
t_nn = ws.Range("D4").Value
If t_hh < 0 Or t_hh > 100 Or t_nn < 0 Or t_nn > 59 Then err = True
t_ss = t_hh * 60 * 60 + t_nn * 60
If t_ss = 0 Then err = True
If err = True Then
MsgBox ("タイマー不正")
Exit Sub
End If
t1 = Now
t2 = t1 + t_ss

UserForm1.Show vbModeless
UserForm1.Repaint
Do
t2 = Now
diff = t_ss - DateDiff("s", t1, t2)
UserForm1.TextBox2 = sec2hhmmss(diff)
If diff <= 0 Then Exit Do
DoEvents
Loop
MsgBox ("timeout")
End Sub

Public Function sec2hhmmss(ByVal cnt_d As Long) As String
Dim hh As Long
Dim nn As Long
Dim ss As Long
Dim amari As Long
hh = cnt_d \ (60 * 60)
amari = cnt_d Mod (60 * 60)
nn = amari \ 60
ss = amari Mod 60
sec2hhmmss = Format(hh, "00") & ":" & Format(nn, "00") & ":" & Format(ss, "00")
End Function

GooUserラック · Answer

ついでに言うと終了判定は「If UserForm1.TextBox2 = "00:00:00" Then Exit Do」ではなく「If cnt_d <= 0 Then Exit Do」にされた方が良いですよ。

GooUserラック · Answer

検証したわけではありませんが以下ではどうですか？

Sub timer()
Dim limit As Date, cnt_d As Double

limit = DateAdd("n", Range("D4"), Time)
limit = DateAdd("h", Range("B4"), Time)

UserForm1.Show vbModeless
UserForm1.Repaint

Do
　cnt_d = DateDiff("s", Time, limit)

UserForm1.TextBox2 = Format(cnt_d / 86400, "hh:nn:ss")
　If UserForm1.TextBox2 = "00:00:00" Then Exit Do

DoEvents
Loop

End Sub

tatsu99 · Answer

cnt_dをhh:mm:ss形式の文字列に変換する関数を自前で作成しました。
下記の関数を
UserForm1.TextBox2 = sec2hhmmss(cnt_d)
として呼び出してください。hhは23時間の場合でも、その数値が表示されます。
（72時間の場合、72:00:00のようになります。１００時間なら100:00:00になります）

Public Function sec2hhmmss(ByVal cnt_d As Long)
    Dim hh As Long
    Dim nn As Long
    Dim ss As Long
    Dim amari As Long
    hh = cnt_d \ (60 * 60)
    amari = cnt_d Mod (60 * 60)
    nn = amari \ 60
    ss = amari Mod 60
    sec2hhmmss = Format(hh, "00") & ":" & Format(nn, "00") & ":" & Format(ss, "00")
End Function

よろずやkinchan · Answer

TimeSerial(0, 0, cnt_d)
時、分、秒に入れられる値は、Integer の範囲の値です。
最大 32767 になります。

VBAで72時間タイマーがオーバーフローします…

＞試してみましたが、オーバーフローは無いものの表示が正しくありません…何故か0表示のままになります。

ついでに言うと終了判定は「If UserForm1.TextBox2 = "00:00:00" Then Exit Do」ではなく「If cnt_d <= 0 Then Exit Do」にされた方が良いですよ。

検証したわけではありませんが以下ではどうですか？

cnt_dをhh:mm:ss形式の文字列に変換する関数を自前で作成しました。

TimeSerial(0, 0, cnt_d)

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング