日付及び時間に関する計算色々(VB6.0) - VBレスキュー(花ちゃん)

Private Sub Command1_Click()
'指定した日数を加算した日付を求める
'バリアント型Date = DateAdd(時間間隔、加算する時間間隔、基準日付)
'==============================================
'　時間間隔　　yyyy　　年
'　　　　　　　 q　　　四半期
'　　　　　　　 m　　　月
'　　　　　　　 y　　　年間通算日
'　　　　　　　 d　　　日
'　　　　　　　 ww　　　週
'　　　　　　　 h　　　時
'　　　　　　　 n　　　分
'　　　　　　　 s　　　秒
'===============================================
　　Debug.Print DateAdd("yyyy", 5, "2013/07/21 00:00:00")　 '2018/07/21　　　　 (5年後)
　　Debug.Print DateAdd("q", 5, "2013/07/21 00:00:00")　　　'2014/10/21　　　　 (5四半期後　15ヶ月後)
　　Debug.Print DateAdd("m", 5, "2013/07/21 00:00:00")　　　'2013/12/21　　　　 (5ヶ月後)
　　Debug.Print DateAdd("y", 5, "2013/07/21 00:00:00")　　　'2013/07/26　　　　 (5日後)
　　Debug.Print DateAdd("d", 5, "2013/07/21 00:00:00")　　　'2013/07/26　　　　 (5日後)
　　Debug.Print DateAdd("ww", 5, "2013/07/21 00:00:00")　　 '2013/08/25　　　　 (5週後)
　　Debug.Print DateAdd("h", 5, "2013/07/21 00:00:00")　　　'2013/07/21 5:00:00 (5時間後)
　　Debug.Print DateAdd("n", 5, "2013/07/21 00:00:00")　　　'2013/07/21 0:05:00 (5分後)
　　Debug.Print DateAdd("s", 5, "2013/07/21 00:00:00")　　　'2013/07/21 0:00:05 (5秒後)
End Sub

２．２つの日付の時間間隔を求める

Private Sub Command1_Click()
'2つの日付の時間間隔を求める
'バリアント型Date=DateDiff(時間間隔、Date1,Date2,,)
'==============================================
'　時間間隔　　yyyy　　年
'　　　　　　　 q　　　四半期
'　　　　　　　 m　　　月
'　　　　　　　 y　　　年間通算日
'　　　　　　　 d　　　日
'　　　　　　　 ww　　　週
'　　　　　　　 h　　　時
'　　　　　　　 n　　　分
'　　　　　　　 s　　　秒
'===============================================
　　Debug.Print DateDiff("yyyy", "2012/12/31　00:00:00", "2013/01/1 00:00:00")　'1　　　　　(経過年数)
　　Debug.Print DateDiff("yyyy", "2001/12/01　00:00:00", "2013/07/21 00:00:00") '12　　　　 (経過年数)

　　Debug.Print DateDiff("q", "2001/12/01　00:00:00", "2013/07/21 00:00:00")　　'47　　　　 (経過四半期数)

　　Debug.Print DateDiff("m", "2012/12/31　00:00:00", "2013/01/1 00:00:00")　　 '1　　　　　(経過月数)
　　Debug.Print DateDiff("m", "2001/12/01　00:00:00", "2013/07/21 00:00:00")　　'139　　　　(経過月数)

　　Debug.Print DateDiff("y", "2001/12/01　00:00:00", "2013/07/21 00:00:00")　　'4250　　　 (経過日数)
　　Debug.Print DateDiff("d", "2001/12/01　00:00:00", "2013/07/21 00:00:00")　　'4250　　　 (経過日数)
　　Debug.Print DateDiff("ww", "2001/12/01　00:00:00", "2013/07/21 00:00:00")　 '608　　　　(経過週)
　　Debug.Print DateDiff("h", "2001/12/01　00:00:00", "2013/07/21 00:00:00")　　'102000　　 (経過時間)
　　Debug.Print DateDiff("n", "2001/12/01　00:00:00", "2013/07/21 00:00:00")　　'6120000　　(経過分数)
　　Debug.Print DateDiff("s", "2001/12/01　00:00:00", "2013/07/21 00:00:00")　　'367200000　(経過秒数)
End Sub

上記の実行例でも分かる通り満の年数や月数ではありませんので注意が必要です。
尚、Excel の DATEDIF 関数は、満の年数や月数を返します。

３．時間を通常のように演算する

単純な時間計算なら

　Private Sub Command1_Click()
　　　Dim dtmData1 As Date
　　　Dim dtmData2 As Date

　　　dtmData1 = CDate("10:25")
　　　dtmData2 = CDate("15:40")
　　　'CInt　では数値がまるめられるので
　　　Text1.Text = Format$(Int(CSng(dtmData1 + dtmData2)) * 24 + _
　　　　　　　　　　Hour(dtmData1 + dtmData2), "00\:") & _
　　　　　　　　　　　　　　　Format$(dtmData1 + dtmData2, "nn")
　End Sub

で出来るのですが?日付データを扱っているので積算には向かないようです。
このようにVB5になってもあまり便利な関数はないみたいです?
24時間以内での演算はできるのですが、月の残業時間の集計等にはもうひとつ使いづらい。
そこで独自の関数を作ってみました。

hh1に最初の時間をmm1に最初の分をss1に最初の秒を入力します
hh2に次の時間をmm2に次の分をss2に次の秒を入力します
enzanには足算するか、引算するかを入力します
返り値は文字列で "14:12:20" のように表示します。
又、　hh　　mm　ss　の別々にも求められます。

フォームに下記のように各コントロールを貼り付け以下のコードを貼り付けて下さい。
　 datetime06_01

Option Explicit　　 'SampleNo=063　 2002.05.14

Dim hh As Long
Dim mm As Long
Dim ss As Long

Private Function Jikan(ByRef hh1 As Long, ByRef mm1 As Long, _
　　　　　　　 ByRef ss1 As Long, ByRef hh2 As Long, _
　　　　　　　 ByRef mm2 As Long, ByRef ss2 As Long, _
　　　　　　　 ByVal enzan As Long) As String
　　Dim byo1 As Long, byo2 As Long, byo3 As Long
　　Dim h1 As Long, m1 As Long, s1 As Long, nn As Long

　　byo1 = (hh1 * 3600) + (mm1 * 60) + ss1
　　byo2 = (hh2 * 3600) + (mm2 * 60) + ss2

　　If enzan = 1 Then　　　　'1の場合のみ引き算
　　　　byo3 = byo1 - byo2
　　Else
　　　　byo3 = byo1 + byo2
　　End If
　　h1 = byo3 \ 3600
　　m1 = byo3 Mod 3600: nn = m1
　　m1 = nn \ 60
　　s1 = nn Mod 60
　　hh = h1: mm = m1: ss = s1
　　Jikan = h1 & ":" & Format$(m1, "00") & ":" & Format$(s1, "00")
End Function

Private Sub Check1_Click()
　　If Check1.Value = vbChecked Then
　　　　Text3.Visible = False
　　　　Label3.Visible = False
　　　　Check1.Caption = "秒の計算をする"
　　Else
　　　　Text3.Visible = True
　　　　Label3.Visible = True
　　　　Check1.Caption = "秒の計算を省く"
　　End If
　　Text1.SetFocus
End Sub

Private Sub Command1_Click()
　　On Error Resume Next
　　Dim Nowhh As Long, Nowmm As Long
　　Dim Nowss As Long, enzan As Long
　　Dim ret As String
　　If Option1.Value = True Then
　　　　enzan = 0
　　Else
　　　　enzan = 1
　　End If
　　Nowhh = CLng(Text1.Text)
　　Nowmm = CLng(Text2.Text)
　　Nowss = CLng(Text3.Text)
　　ret = Jikan(hh, mm, ss, Nowhh, Nowmm, Nowss, enzan)
　　Text4.Text = ret
　　Text1.Text = ""
　　Text2.Text = ""
　　Text3.Text = ""
　　Text1.SetFocus
End Sub

Private Sub Command2_Click()
　　hh = 0
　　mm = 0
　　ss = 0
　　Text4.Text = ""
　　Text1.SetFocus
End Sub

Private Sub Form_Activate()
　　Text1.SetFocus
End Sub

Private Sub Form_Unload(Cancel As Integer)
　　Unload Me
End Sub

Private Sub Option1_Click()
　　Text1.SetFocus
End Sub

Private Sub Option2_Click()
　　Text1.SetFocus
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
　　'0~9の数値と- と制御キーだけ入力OK
　　If KeyAscii >= 32 And KeyAscii < 45 Or KeyAscii > 57 Or _
　　　　　　　　　　　　　KeyAscii = 46 Or KeyAscii = 47 Then
　　　　Beep　　　　　　　　　　 'エラー音
　　　　KeyAscii = 0　　　　　　 '入力キーを無効にする
　　End If
　　If KeyAscii = vbKeyReturn Then
　　　　KeyAscii = 0
　　　　Text1.Enabled = False
　　　　Text1.Enabled = True
　　End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
　　If KeyAscii >= 32 And KeyAscii < 45 Or KeyAscii > 57 Or _
　　　　　　　　　　　　　KeyAscii = 46 Or KeyAscii = 47 Then
　　　　Beep　　　　　　　　　　 'エラー音
　　　　KeyAscii = 0　　　　　　 '入力キーを無効にする
　　End If
　　If KeyAscii = vbKeyReturn Then
　　　　KeyAscii = 0
　　　　Text2.Enabled = False
　　　　Text2.Enabled = True
　　End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
　　If KeyAscii >= 32 And KeyAscii < 45 Or KeyAscii > 57 Or _
　　　　　　　　　　　　　KeyAscii = 46 Or KeyAscii = 47 Then
　　　　Beep　　　　　　　　　　 'エラー音
　　　　KeyAscii = 0　　　　　　 '入力キーを無効にする
　　End If
　　If KeyAscii = vbKeyReturn Then
　　　　KeyAscii = 0
　　　　Text3.Enabled = False
　　　　Text3.Enabled = True
　　End If
End Sub

特に難しいことはしていないのでコードをよく見てもらえば理解できるか思います、その分あまりスマートなコードとは言えませんが。

４．期間内の満の年月日を求める(Excel の DateDiff 似関数)

Private Sub Command1_Click()
　　Dim d1 As Date, d2 As Date
　　d1 = "2001/12/01"　　　 '愛子様の誕生日
　　d2 = Now　　　　　　　　'2013/07/21
　　Debug.Print fDateDif(d1, d2, "Y")　 '11
　　Debug.Print fDateDif(d1, d2, "M")　 '139
　　Debug.Print fDateDif(d1, d2, "D")　 '4250
　　Debug.Print fDateDif(d1, d2, "YM")　'7
　　Debug.Print fDateDif(d1, d2, "YD")　'232
　　Debug.Print fDateDif(d1, d2, "MD")　'20
　　Debug.Print "愛子様は、" & fDateDif(d1, d2, "Y") & "才" & fDateDif(d1, d2, "YM") & _
　　　　　　　　"ケ月と" & fDateDif(d1, d2, "MD") & "日です。"　 '愛子様は、11才7ケ月と20日です。
End Sub

Private Function fDateDif(ByVal date1 As Date, _
　　　　　　　　　　　　　ByVal date2 As Date, ByVal interval As String) As Integer
　　Dim man As Boolean
　　Dim y1 As Integer
　　Dim y2 As Integer
　　Dim yyyy1 As Integer
　　Dim yyyy2 As Integer
　　Dim mm1　 As Integer
　　Dim mm2　 As Integer
　　Dim dd1　 As Integer
　　Dim dd2　 As Integer
　　y1 = CInt(Format$(date1, "y"))
　　y2 = CInt(Format$(date2, "y"))
　　yyyy1 = CInt(Format$(date1, "yyyy"))
　　yyyy2 = CInt(Format$(date2, "yyyy"))
　　mm1 = CInt(Format$(date1, "mm"))
　　mm2 = CInt(Format$(date2, "mm"))
　　dd1 = CInt(Format$(date1, "dd"))
　　dd2 = CInt(Format$(date2, "dd"))
　　If y1 <= y2 Then
　　　　man = True
　　End If
　　Select Case interval
　　　　Case "Y"　　'期間内の満年数
　　　　　　fDateDif = yyyy2 - yyyy1
　　　　　　If man = False Then
　　　　　　　　fDateDif = fDateDif - 1
　　　　　　End If
　　　　Case "M"　　'期間内の満月数
　　　　　　fDateDif = DateDiff("m", date1, date2)
　　　　　　If dd2 < dd1 Then
　　　　　　　　fDateDif = fDateDif - 1
　　　　　　End If
　　　　Case "D"　　'期間内の日数
　　　　　　fDateDif = DateDiff("d", date1, date2)
　　　　Case "YM"　 '経過した1年未満の月数
　　　　　　fDateDif = DateDiff("m", CStr(yyyy2 - 1) & "/" & CStr(mm1) & "/" & CStr(dd1), date2)
　　　　　　If dd2 < dd1 Then
　　　　　　　　fDateDif = fDateDif - 1
　　　　　　End If
　　　　　　If fDateDif = 12 Then
　　　　　　　　fDateDif = 0
　　　　　　End If
　　　　Case "YD"　 '経過した1年未満の日数
　　　　　　fDateDif = DateDiff("d", CStr(yyyy2) & "/" & CStr(mm1) & "/" & CStr(dd1), date2)
　　　　　　If man = False Then
　　　　　　　　fDateDif = DateDiff("d", CStr(yyyy2 - 1) & "/" & CStr(mm1) & "/" & CStr(dd1), date2)
　　　　　　End If
　　　　Case "MD"　 '経過した1月未満の日数
　　　　　　fDateDif = dd2 - dd1
　　　　　　If fDateDif < 0 Then
　　　　　　　　fDateDif = DateDiff("d", CStr(yyyy2) & "/" & CStr(mm2 - 1) & "/" & CStr(dd1), date2)
　　　　　　End If
　　End Select
End Function

　 "Y"　: 期間内の満年数
　 "M"　: 期間内の満月数
　 "D"　: 期間内の日数
　 "YM" : 経過した1年未満の月数
　 "YD" : 経過した1年未満の日数
　 "MD" : 経過した1月未満の日数

５．

６．

VBレスキュー(花ちゃん)

Visual Basic 6.0