VBA入力フォームで労働時間の計算をしたい

VBAで入力フォームを作りました。

　1）開始時間（textbox1)・終了時間（textbox2)・休憩時間（textbox3)・従事人数（textbox4)
の入力を行うと自動的に延べ労働時間（textbox5)計算し表示をしたいです。

　【例：13：00（開始）　14：00（終了）　0：15（休憩１５分）　5（従事人数）　＝3：45（textbox5)】

　例の3：45という答えがでる計算式を教えていただけないでしょうか？

また、上記の同項目が１０個あり、延べ労働時間の合計を表示するところも作りました。（textbox6)

　2）時間記入時13：00と入力が面倒なので『1300』というように『：』を省略したいです。
　　　なお答えの欄は『：』の表記したいです。

　3）また、計算終了後、表記入のボタンを押すと指定したセルに（textbox6)の答えが表示できるよう作成したいです。

　

　０からの質問で恐縮ですが1）～3）の質問お願いについてご回答よろしくお願いいたします。

No.3 回答者： WindFaller 回答日時： 2015/01/15 11:16

#2の回答者ですが、

VBAとはいうものの、何のVBAか分かりませんでしたから、あくまでも、Excelを想定していました。

>同項目が１０個あり、延べ労働時間の合計を表示するところも作りました。（textbox6)
この件については、数とTextBoxの関係が、良く分からなかったせいもあるのですが、私の場合、それぞれの合計値を、モジュールスコープの変数を増やしておけば可能です。

私の場合は、TextBox4の入力で自動計算させるように出来ていますが、そうでない場合は、ボタンに切り替えればよいです。計算式は、TextBox4の中にあります。

>１行の計算が出来たのですが
>他９行の計算式は回答ただいた式をコピーして『textbox』数字を変更していけばよろしいのでしょうか？

私は、他人のコードの解説はしませんが、もし、「Excel」でしたら、一旦、ワークシート側のセルで計算させて、そのセルの計算値を、Textプロパティで拾い上げるようにしたほうが、複雑にならなくてよいかもしれません。確か、Excelでは、セルとリンクさせることが出来たと思います。

あくまでも、ひとつの提案です。

この回答へのお礼

ご回答ありがとうございました。

いろいろと参考にさせて頂き理想としていた事ができました。

お礼日時：2015/01/17 09:58

No.2 回答者： WindFaller 回答日時： 2015/01/14 21:52

こんばんは。

その計算は、時間計算であっても、実際は24時間を越えていくものだとすれば、VBAには、[h]:mmというフォーマットがありませんから、一旦、入力された数字は、シリアル値にして計算せざるを得ませんね。

私の場合は、TextBox4 に数値を入れた時点で、計算をするようにしました。
1300　は、13:00 に変わりますが、13000 は、130:00 時間になってしまいます。

UserForm モジュールです。

'//
Dim StartTime As Variant
Dim FinTime As Variant
Dim RestTime As Variant
'Dim Persons As Variant　'ボタンなどで計算する時は、これを活かす
Dim TimeText As Variant

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
　StartTime = Time2Serial(TextBox1.Text)
　TextBox1.Text = TimeText
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
　FinTime = Time2Serial(TextBox2.Text)
　TextBox2.Text = TimeText
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
　RestTime = Time2Serial(TextBox3.Text)
　TextBox3.Text = TimeText
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim buf As Variant
Dim dum As Variant
Dim i As Variant
　i = Val(TextBox4.Text)
　If StartTime > FinTime Then MsgBox "開始時間の方が後になっています。", 48: Exit Sub
　buf = (FinTime - StartTime - RestTime) * i
　dum = Time2Serial(buf) '特に出力する必要はない。
　TextBox5.Text = TimeText
End Sub

Function Time2Serial(num As Variant)
　Dim uNum As Variant
　Dim lNum As Variant
　Dim mTime As Double
　num = Replace(num, ":", "", , , vbTextCompare)　'間違って「：」を入れた時には取る
　If num = "" Then Exit Function
　If num - Int(num) = 0 Then
　　num = Format(num, "00:00")
　　uNum = Mid(num, 1, InStr(num, ":") - 1)
　　lNum = Mid(num, InStr(num, ":") + 1)
　　
　　If lNum > 60 Then
　　　MsgBox "時間値にエラーがあります。", 48
　　　ActiveControl.Text = ""　'入力しているTextBox のこと
　　　Exit Function
　　End If
　Else
　　uNum = Int(num * 24)
　　lNum = (num * 24 - Int(num * 24)) * 60
　End If
　mTime = uNum / 24 + lNum / (24 * 60)
　If mTime < 10 ^ -6 Then
　 mTime = 0
　 TimeText = "Not Calculate, Too small" '微細な数値は出さない
　 Exit Function
　Else
　Time2Serial = mTime
　TimeText = Format(uNum, "0") & ":" & Format(lNum, "00")　'丸めている
　End If
End Function
'//

No.1 回答者： x-1919 回答日時： 2015/01/14 14:50

エラー処理は何もしていません。

無駄も多いです。
一つぶんの延べ労働時間しか計算していませんし、セルへの転記もしていません。
ですので ":" の入力を省略する部分しか回答できていませんね。

《開始時刻と終了時刻》
n は、入力された文字列の右から 2文字
h は、入力された文字列の頭に "00" を付けたうえで右から 4文字を切り取り、それをリバースして右から 2文字を切り取り、再度リバース

123 → 頭に "00" を付ける
00123 → 右から 4文字を切り取る
0123 → リバースする
3210 → 右から 2文字分を切り取る
10 → リバースする
01

1123 → 頭に "00" を付ける
001123 → 右から 4文字を切り取る
1123 → リバースする
3211 → 右から 2文字分を切り取る
11 → リバースする
11

《休憩時間》
方法は開始時刻等と同じように読み取ったものを分に変換

《労働時間》
休憩した時間だけ終了時刻を戻したものと、開始時刻の差を分で計算

《延べ労働時間》
労働時間 (分) に人数を掛け、"h:nn" の形式に変換


インデントに全角スペースを使ってますのでご注意ください。
Private Sub CommandButton1_Click()
　Dim startTime As Date ' 開始時刻
　startTime = CreateTimeValue(Me.TextBox1.Text)

　Dim endTime As Date ' 終了時刻
　endTime = CreateTimeValue(Me.TextBox2.Text)

　Dim breakTime As Long ' 休憩した時間
　breakTime = Hour(CreateTimeValue(Me.TextBox3.Text)) * 60 + Minute(CreateTimeValue(Me.TextBox3.Text))

　Dim laborTime As Long ' 一人あたりの有効労働時間
　laborTime = DateDiff("n", startTime, DateAdd("n", breakTime * -1, endTime))

　Dim quantity As Long ' 人数
　quantity = Me.TextBox4.Text

　Dim totalTime As Long ' 延べ労働時間 (分)
　totalTime = laborTime * quantity

　Dim totalTimeFormated As String ' 延べ労働時間 (h:nn)
　totalTimeFormated = (totalTime \ 60) & ":" & Format((totalTime Mod 60), "00")

　Me.TextBox5.Text = totalTimeFormated
End Sub

Private Function CreateTimeValue(aSource As String) As Date
　Dim hourValue As String
　Dim minuteValue As String
　
　hourValue = StrReverse(Right(StrReverse(Right("00" & aSource, 4)), 2))
　minuteValue = Right(aSource, 2)
　
　CreateTimeValue = TimeSerial(hourValue, minuteValue, 0)
End Function

この回答への補足

ご回答ありがとうございます。

すごい！時間計算できました。

１行の計算が出来たのですが
他９行の計算式は回答ただいた式をコピーして『textbox』数字を変更していけばよろしいのでしょうか？

あるいは範囲指定できるのでしょうか？

そして、その延べ労働時間欄の答えを合計するのはできますでしょうか？

よろしければご回答お願いいたします。

補足日時：2015/01/15 10:24

この回答へのお礼

ご回答ありがとうございました。

　いろいろと参考になりまして、理想に近づいた作業ができるようになりました。

お礼日時：2015/01/17 10:04