|
横から失礼します。
▼ハト さん:
またコッソリ勉強させていただいてました^^
今回も上手いロジックですね。
それでちょっとよく分からないのですが、
私のところで12: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 TVal As Long
Dim NVal As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Columns("a:b").ColumnWidth = 12
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
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
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
If TTime >= NTime Then Exit Do
Loop
If NVal > 1500 Then NVal = 1500
TVal = TVal + NVal
ws.Cells(i, 3) = TVal
Next i
End Sub
これを実行すると開始が12:00以降だと結果が1200ではなく1600になってしまいます。
そして13:00〜13:20ではちゃんと結果が400になるのですが
13:00〜13:40では結果が800のはずが1200になっています。
(〜13:39は800〜13:41は1200で問題ありません)
どうも”12:00以降だけ”2回以上ループすると
> If TTime >= NTime Then Exit Do
の"="が働いていないような感じです。
ちょっと原因がよく分かりません。エクセルの設定か何かでしょうか?
ちなみ【38537】のDateAddを使用したものでは問題は起きませんでした。
|
|