|
▼ハト さん:
ありがとうございます。
>DataAddを使っても誤差が出るようです
>
>誤差を計測してみたところ
>『1.11022302462516E-16』
>小数点以下16桁(^^;
この計測の仕方、よろしければご教授下さい。
>
>1分の値が
>『0.000694444444444444』
>
>これだと比較している箇所はRoundを使って、
>小数点以下8桁をまるめてしまえば誤差を無視できそうですね(^^;
>
> If TTime >= NTime Then Exit Do
> ↓
> If Round(TTime, 8) >= Round(NTime, 8) Then Exit Do
わたしもどこかで「日時はシリアル値」というのを聞いたのを思い出し、
調べたところ詳細に解説されてました^^
http://www.h3.dion.ne.jp/~sakatsu/TimeSerial_Error.htm
なので私も
> If TTime >= NTime Then Exit Do
を
TTime = TimeValue(Format(TTime, "h:mm"))
NTime = TimeValue(Format(NTime, "h:mm"))
If TTime >= NTime Then Exit Do
としてみたところ解決しました。
ただ、↓のようにテストしていたのですが、
14:00〜16:00や17:00〜18:00など割り切れている
ところでは誤差が出ないように思えるのですが・・・
しかし上記のようにすると正しい結果が得られるので
表示の仕方の問題でしょうか?
Sub Test_Time()
Dim ws As Worksheet
Dim STime As Date
Dim ETime As Date
Dim NTime As Date
Dim TTime As Date
Dim ATime As Date
Dim i As Long
Dim j As Long
Dim TVal As Long
Dim NVal As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Columns("a:b").ColumnWidth = 12
ws.Columns("e:f").ColumnWidth = 16
ATime = TimeValue("6:00")
For i = 1 To 14
ws.Cells(i, 1) = ATime
ATime = ATime + TimeValue("1:00")
ws.Cells(i, 2) = ATime
Next i
j = 1
For i = 1 To 14
TVal = 0
NVal = 0
STime = TimeValue(ws.Range(Cells(i, 1), Cells(i, 1)).Text)
ETime = TimeValue(ws.Range(Cells(i, 2), Cells(i, 2)).Text)
If STime > ETime Then
NTime = TimeValue("23:59")
Else
NTime = ETime
End If
TTime = STime
ws.Cells(j, 5) = CStr(STime) & "〜" & CStr(ETime)
Do
Select Case TTime
Case Is > TimeValue("23:29")
NVal = NVal + 300
If NTime = ETime Then Exit Do
TTime = TTime - TimeValue("23:30")
NTime = ETime
Case Is >= TimeValue("20:00")
TTime = TTime + TimeValue("0:30")
NVal = NVal + 300
Case Is >= TimeValue("6:00")
TTime = TTime + TimeValue("0:20")
TVal = TVal + 400
Case Else
TTime = TTime + TimeValue("1:00")
NVal = NVal + 200
End Select
j = j + 1
ws.Cells(j, 5) = CDbl(TTime)
ws.Cells(j, 6) = CDbl(NTime)
' TTime = TimeValue(Format(TTime, "h:mm"))
' NTime = TimeValue(Format(NTime, "h:mm"))
If TTime >= NTime Then Exit Do
Loop
j = j + 1
If NVal > 1500 Then NVal = 1500
TVal = TVal + NVal
ws.Cells(i, 3) = TVal
Next i
Range("a1").Select
End Sub
|
|