| |
▼mai さん：
おはようございます。
新規ブックの標準モジュールに
'===============================================================
Option Explicit
Sub main()
Dim idx As Long, jdx As Long
Dim t_m As Long
Dim n_m() As Variant
Dim st As Date, ed As Date
Dim std As Date
Dim l_rng As Range
On Error Resume Next
Set l_rng = Range("d1:d3")
t_m = 0
st = Range("a1").Value
ed = Range("b1").Value
std = Int(st)
If st > ed Then ed = ed + 1
Do While st < ed
idx = Application.Match(st - Int(st), l_rng, 1)
If l_rng.Cells(idx, 4).Value = -1 Then
t_m = t_m + l_rng.Cells(idx, 2).Value
Else
jdx = Int(st) - std + l_rng.Cells(idx, 4).Value
Err.Clear
n_m(jdx) = n_m(jdx) + l_rng.Cells(idx, 2).Value
If Err.Number <> 0 Then
ReDim Preserve n_m(jdx)
n_m(jdx) = 0
n_m(jdx) = n_m(jdx) + l_rng.Cells(idx, 2).Value
End If
End If
st = st + l_rng.Cells(idx, 3).Value
st = CDate(CStr(st))
Loop
For idx = LBound(n_m()) To UBound(n_m())
t_m = t_m + IIf(n_m(idx) > 1500, 1500, n_m(idx))
Next
MsgBox t_m
End Sub
'===============================================================
Sub set_hyo()
Call set_list
Range("A1:B1").NumberFormatLocal = "h:mm"
End Sub
'===============================================================
Function set_list() As Range
Const セル範囲 = "d1:d3"
Const リスト = "={""0:00"",200,""1:00"",0;""6:00"",400,""0:20"",-1;""20:00"",300,""0:30"",1}"
Set set_list = Range(セル範囲)
set_list.Resize(, 4).FormulaArray = Evaluate(リスト)
End Function
としてください。
１．まず、プロシジャーset_hyoを実行してアクティブシートに
料金表を作成してください。
２．アクティブシートのセルＡ１が開始時刻、Ｂ１が終了時刻とします。
３．尚、入力された時刻が 開始時刻＜終了時刻という場合は、終了時刻は翌日の時刻
だと解釈します。
４．開始時刻、終了時刻を入力後、プロシジャーmainを実行してください。
料金が表示されます。
入力例
セルＡ１ 5:00 Ｂ１ 8:00 料金 2600
セルＡ１ 21:00 Ｂ１ 0:00 料金 1500
（この場合、自動的に翌日の0：00と解釈します）
セルＡ１ 5:00 Ｂ１ 7:10 料金 600
セルＡ１ 19:00 Ｂ１ 21:00 料金 1800
という結果を表示します。
確認してください。
これ難しいのは、時刻は少数だから誤差が出るんだよね！！
補正したつもりですが、十分な確認をしていません・・。
検証してみてください。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
