| |
▼roxy さん：
こんにちは
もしまだご覧でしたら、
私も”誤差”含んでいるのが気になっていたので、
方法の1つとしてすべて整数でやるというのはどうですか？
そうすればシリアル値の”誤差”を気にしなくてよくなります。
ハトさんのを元に整数処理にして、日付越えを入れてみました。
このやり方なら上限金額もＯＫなはずです。
'********************************************************
Sub Test_Time()
Dim ws As Worksheet
Dim SDate As Date
Dim EDate As Date
Dim MDate As Long
Dim STime As Long
Dim ETime As Long
Dim TVal As Long
Dim NVal() As Long
MDate = 0
TVal = 0
i = 0
ReDim NVal(i)
NVal(i) = 0
Set ws = ThisWorkbook.Worksheets("Sheet1")
SDate = ws.Range("A1").Text
EDate = ws.Range("C1").Text
STime = (CLng(Format(ws.Range("B1").Text, "h")) * 60) + CLng(Format(ws.Range("B1").Text, "n"))
ETime = (CLng(Format(ws.Range("D1").Text, "h")) * 60) + CLng(Format(ws.Range("D1").Text, "n"))
MDate = DateDiff("d", SDate, EDate)
ETime = ETime + (1440 * MDate)
Do
Select Case STime
Case Is >= 1200 '20:00
STime = STime + 30
NVal(i) = NVal(i) + 300
Case Is >= 360 '6:00
STime = STime + 20
TVal = TVal + 400
If NVal(i) <> 0 Then
i = i + 1
ReDim Preserve NVal(i)
End If
Case Else
STime = STime + 60
NVal(i) = NVal(i) + 200
End Select
If STime >= 1440 Then '24:00
STime = STime - 1440
ETime = ETime - 1440
End If
If STime >= ETime Then Exit Do
Loop
For i = LBound(NVal) To UBound(NVal)
If NVal(i) > 1500 Then
TVal = TVal + 1500
Else
TVal = TVal + NVal(i)
End If
Next i
ws.Range("E1").Value = TVal
End Sub
'********************************************************
余談ですが、
>もし５：５０から７：１０でしたら、最初の１時間（５：５０〜６：５０）は\２００、
>その後は（６：５０〜７：１０）は\４００となります。
>それぞれの時間帯に１分でも入っている場合はその料金が採用されます。
これ、ちょっと微妙に思えるのですが・・・
３：５９〜６：５９ ￥６００
４：０１〜６：５９ ￥１６００
仕様・・・
|
|
sin
- 06/6/8(木) 15:54 -
