Блог

Моя проблема в том, что я пытаюсь настроить скользящий подсчет с момента нашей последней аварии на работе. Приведенный ниже код работает определенным образом. Скользящий счетчик работает нормально, но есть проблема с удалением «s» из слов (часы, минуты, секунды и т. Д.) С месяцем и минутой.

Вот мой код:

 Sub LTI_Sub()

Static etime

'Exit Sub ' Uncomment to Stop

etime = Now()   TimeSerial(0, 0, 1)

Sheets("LTI").Range("Time") = LTI(Sheets("LTI").Range("Last"))

Application.OnTime etime, "LTI_Sub", , True


End Sub


Function LTI(LastLTI As Date)

x = Now() - LastLTI

Yx = Format(x, "yy")
If Yx = 1 Then
YS = ""
Else
YS = "s"
End If

Mx = Format(x, "mm")
If Mx = 1 Then
MS = ""
Else
MS = "s"
End If

Dx = Format(x, "DD")
If Dx = 1 Then
Ds = ""
Else
Ds = "s"
End If

Hx = Format(x, "HH")
If Hx = 1 Then
Hs = ""
Else
Hs = "s"
End If

MMx = Format(x, "MM")
If MMx = 1 Then
MMs = ""
Else
MMs = "s"
End If

Sx = Format(x, "SS")
If Sx = 1 Then
Ss = ""
Else
Ss = "s"
End If

LTI = Format(x, "YY Year" amp; YS amp; ", mm Month" amp; MS amp; ", DD Day" amp; Ds amp; "," amp; vbNewLine amp; "HH Hour" amp; Hs amp; ", MM Minute" amp; MMs amp; ", And SS Second" amp; Ss)

End Function
 

Теперь я не уверен, как VBA знает разницу между mm и MM когда дело доходит до фактического форматирования времени, но в строках, где Mx и MMx определяются, если требуется «s», он всегда обрабатывает его как значение месяца. Как мне указать, что это минуты?

Также есть странная «ошибка» в строке x = Now() - LastLTI (где LastLTI указана дата последней аварии). При возврате в VBA он возвращается с дополнительным месяцем и днем, но при выполнении в Excel он возвращает правильное значение. Так, например, если с момента аварии lat прошел ровно 1 день (вплоть до второго), VBA возвращает следующую строку: «00 лет, 01 месяц, 02 дня, 00 часов, 00 минут, 00 секунд» <- Обратите внимание, что в минутах пропало значение S, потому что «Месяц» равно 1.

Надеюсь, это объясняет, чего я пытаюсь достичь!

Заранее спасибо

Я использую несколько разных функций даты, включая DateDiff, которая возвращает разницу между двумя датами, заданными для указанного интервала, а также DateAdd выполняет обратное действие, позволяя вам добавлять указанные интервалы к значению даты. Я также использую TimeValue функцию, которая возвращает только временную часть даты.

Я думаю, это дает то, что вы хотите, или, по крайней мере, должно подвести вас очень близко.

 Function LTI(LastLTI As Date)
Dim yx As Long
Dim mx As Long
Dim dx As Long
Dim hx As Long
Dim mmx As Long
Dim sx As Long
Dim ys As String
Dim ms As String
Dim ds As String
Dim hs As String
Dim mms As String
Dim ss As String

Dim dtNow As Date
dtNow = Now()

yx = DateDiff("yyyy", dtNow, LastLTI)
ys = IIf(yx = 1, "", "s")

mx = DateDiff("m", DateAdd("yyyy", yx, dtNow), LastLTI)
ms = IIf(mx = 1, "", "s")

dx = Format(dtNow - LastLTI, "dd")
ds = IIf(dx = 1, "", "s")

hx = DateDiff("h", TimeValue(dtNow), TimeValue(LastLTI))
hs = IIf(hx = 1, "", "s")

'compute the remaining minutes not allocated to a whole hour, above:
mmx = Format(TimeValue(dtNow), "n") - Format(TimeValue(LastLTI), "n")
mms = IIf(mmx = 1, "", "s")

' compute the remaining seconds not allocated to a whole minute, above:
sx = Format(TimeValue(dtNow), "ss") - Format(TimeValue(LastLTI), "ss")
ss = IIf(sx = 1, "", "s")

LTI = yx amp; "Year" amp; ys amp; ", " amp; _
        mx amp; "Month" amp; ms amp; ", " amp; _
        dx amp; "Day" amp; ds amp; "," amp; vbNewLine amp; _
        hx amp; "Hour" amp; hs amp; ", " amp; _
        mmx amp; "Minute" amp; mms amp; ", And " amp; _
        sx amp; "Second" amp; ss

End Function
 

Вместо использования Format (expression, "mm") в течение нескольких минут, попробуйте Format (expression, "n") .