Конференция VBStreets

**Vladimir!** » 02.10.2005 (Вс) 22:04

Народ, кто-нибудь знает как сделать так, чтоб по заданной дате программа (на основании текущей системной даты) вычисляла колличество лет, месяцев и дней, прошедших с этой даты. Знаю только, как подсчитать колличество дней (всего).

**Vladimir!** » 02.10.2005 (Вс) 22:08

Добавление.
Нужно, чтоб ответ получался примерно такой : 2 года, 3 месяца и 5 дней.

**tyomitch** » 02.10.2005 (Вс) 22:15

Как вариант:

Код: Выделить всё: Dim Date1 As Date, Date2 As Date, Diff As Long Date1 = #4/22/1870# Date2 = Now Diff = DateDiff("yyyy", Date1, Date2) Debug.Print Diff & " лет, "; Date1 = DateAdd("yyyy", Diff, Date1) Diff = DateDiff("m", Date1, Date2) Debug.Print Diff & " месяцев, "; Date1 = DateAdd("m", Diff, Date1) Diff = DateDiff("d", Date1, Date2) Debug.Print Diff & " дней." Date1 = DateAdd("d", Diff, Date1)

**Andrey Fedorov** » 03.10.2005 (Пн) 16:19

tyomitch писал(а):Как вариант:

Не-а - найди ошибку

**Andrey Fedorov** » 04.10.2005 (Вт) 7:50

В общем, вчера удалось выкроить время и набросать процедуру DateInterval. Для подобных случаев, в общем.

Сама процедура с примером использования прилагается - помещайте в FAQ или груду кирпичей :lol:

:

Код: Выделить всё: Public Sub Main() Dim d1 As Date, d2 As Date, y As Long, m As Long, d As Long, h As Long, n As Long, s As Long d1 = #6/22/1941 4:00:00 AM# d2 = Now DateInterval d1, d2, y, m, d Debug.Print vbCrLf & vbCrLf & "Между " & d1 & " и " & d2 & " прошло:" & vbCrLf & String(30, "-") DateInterval d1, d2, y Debug.Print y & " лет" DateInterval d1, d2, y, m, d Debug.Print y & " лет, " & m & " месяцев, " & d & " дней" DateInterval d1, d2, , m, d Debug.Print m & " месяцев, " & d & " дней" DateInterval d1, d2, y, , d Debug.Print y & " лет, " & d & " дней" DateInterval d1, d2, , , d, , , s Debug.Print d & " дней, " & s & " секунд" DateInterval d1, d2, y, m, d, h, n, s Debug.Print y & " лет, " & m & " месяцев, " & d & " дней, " & h & " часов, " & n & " минут, " & s & " секунд" DateInterval d1, d2, , , , h, n Debug.Print h & " часов, " & n & " минут, " & s & " секунд" DateInterval d1, d2, , , , h, , s Debug.Print h & " часов, " & s & " секунд" DateInterval d1, d2, , , , , , s Debug.Print s & " секунд" Debug.Print String(30, "=") & vbCrLf End Sub ' Процедура получает разницу между датами в заданных единицах даты/времени Public Sub DateInterval(d1 As Date, d2 As Date, _ Optional Years As Variant, Optional Months As Variant, Optional Days As Variant, _ Optional Hours As Variant, Optional Minutes As Variant, Optional Seconds As Variant) Const y As String = "yyyy", m As String = "m", d As String = "d", _ h As String = "h", n As String = "n", s As String = "s" Dim dm As Date, dd As Date, dh As Date, dn As Date, ds As Date If IsMissing(Years) Then dm = d1 Else Years = DateDiff(y, d1, d2) dm = DateAdd(y, Years, d1) If dm > d2 Then Years = Years - 1 dm = DateAdd(y, Years, d1) End If End If If IsMissing(Months) Then dd = dm Else Months = DateDiff(m, dm, d2) dd = DateAdd(m, Months, dm) If dd > d2 Then Months = Months - 1 dd = DateAdd(m, Months, dm) End If End If If IsMissing(Days) Then dh = dd Else Days = DateDiff(d, dd, d2) dh = DateAdd(d, Days, dd) If dh > d2 Then Days = Days - 1 dh = DateAdd(d, Days, dd) End If End If If IsMissing(Hours) Then dn = dh Else Hours = DateDiff(h, dh, d2) dn = DateAdd(h, Hours, dh) If dn > d2 Then Hours = Hours - 1 dn = DateAdd(h, Hours, dh) End If End If If IsMissing(Minutes) Then ds = dn Else Minutes = DateDiff(n, dn, d2) ds = DateAdd(n, Minutes, dn) If ds > d2 Then Minutes = Minutes - 1 ds = DateAdd(n, Minutes, dn) End If End If If Not IsMissing(Seconds) Then Seconds = DateDiff(s, ds, d2) End Sub

**alibek** » 04.10.2005 (Вт) 9:12

Andrey Fedorov, ок, но я также и свой вариант выложу

**Andrey Fedorov** » 04.10.2005 (Вт) 10:10

alibek писал(а):Andrey Fedorov, ок, но я также и свой вариант выложу

Ну одно другому не мешает - а сюда его, чтобы сейчас не искать и посмотреть...?

**Andrey Fedorov** » 04.10.2005 (Вт) 10:28

alibek писал(а):Andrey Fedorov, ок, но я также и свой вариант выложу

Кстати, мы немножко по разному считаем - сравни:

23480 дней, 7 часов, 25 минут, 35 секунд
563527 часов, 1535 секунд
==============================
23480 д., 7 ч., 25 м., 35 с.
563527 ч., 35 с.

**alibek** » 04.10.2005 (Вт) 12:59

Э... У меня чуть другой принцип

Эта функция хорошо подходит для таймеров с обратным отсчетом.

**Andrey Fedorov** » 04.10.2005 (Вт) 13:09

alibek писал(а):Э... У меня чуть другой принцип

А, я понял - это фича такая! :lol:

alibek писал(а):Эта функция хорошо подходит для таймеров с обратным отсчетом.

Да куда угодно - где нужна разница временных интервалов - возраст, отработанное время и прочая, прочая...

**Andrey Fedorov** » 04.10.2005 (Вт) 14:14

Для большей законченности добавил следующую фичу - теперь функция может возвратить интервал в виде строкового представления, например:

64 года, 3 месяца, 12 дней, 11 часов, 5 минут, 58 секунд

Ну и собственно функция:

Код: Выделить всё: ' Функция получает разницу между датами в заданных единицах даты/времени ' При ReturnString=True возвращает строковое представление интервала Public Function DateInterval(d1 As Date, d2 As Date, _ Optional Years As Variant, Optional Months As Variant, Optional Days As Variant, _ Optional Hours As Variant, Optional Minutes As Variant, Optional Seconds As Variant, _ Optional ReturnString As Boolean = False) As String Const sr As String = ", " Const y As String = "yyyy", m As String = "m", d As String = "d", _ h As String = "h", n As String = "n", s As String = "s" Dim dm As Date, dd As Date, dh As Date, dn As Date, ds As Date, _ ss As String, i As Integer, sss As String If IsMissing(Years) Then dm = d1 Else Years = DateDiff(y, d1, d2) dm = DateAdd(y, Years, d1) If dm > d2 Then Years = Years - 1 dm = DateAdd(y, Years, d1) End If If ReturnString Then ss = Right$(Format$(Years, "00"), 2) If Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5 Then sss = Years & " лет" Else sss = Years & " год" If Right$(ss, 1) <> "1" Then sss = sss & "а" End If End If End If If IsMissing(Months) Then dd = dm Else Months = DateDiff(m, dm, d2) dd = DateAdd(m, Months, dm) If dd > d2 Then Months = Months - 1 dd = DateAdd(m, Months, dm) End If If ReturnString Then ss = Right$(Format$(Months, "00"), 2) If Len(sss) Then sss = sss & sr sss = sss & Months & " месяц" If Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5 Then sss = sss & "ев" Else If Right$(ss, 1) <> "1" Then sss = sss & "а" End If End If End If If IsMissing(Days) Then dh = dd Else Days = DateDiff(d, dd, d2) dh = DateAdd(d, Days, dd) If dh > d2 Then Days = Days - 1 dh = DateAdd(d, Days, dd) End If If ReturnString Then ss = Right$(Format$(Days, "00"), 2) If Len(sss) Then sss = sss & sr sss = sss & Days & " д" If Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5 Then sss = sss & "ней" Else sss = sss & IIf(Right$(ss, 1) = "1", "ень", "ня") End If End If End If If IsMissing(Hours) Then dn = dh Else Hours = DateDiff(h, dh, d2) dn = DateAdd(h, Hours, dh) If dn > d2 Then Hours = Hours - 1 dn = DateAdd(h, Hours, dh) End If If ReturnString Then ss = Right$(Format$(Hours, "00"), 2) If Len(sss) Then sss = sss & sr sss = sss & Hours & " час" If Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5 Then sss = sss & "ов" Else If Right$(ss, 1) <> "1" Then sss = sss & "а" End If End If End If If IsMissing(Minutes) Then ds = dn Else Minutes = DateDiff(n, dn, d2) ds = DateAdd(n, Minutes, dn) If ds > d2 Then Minutes = Minutes - 1 ds = DateAdd(n, Minutes, dn) End If If ReturnString Then ss = Right$(Format$(Minutes, "00"), 2) If Len(sss) Then sss = sss & sr sss = sss & Minutes & " минут" If Not (Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5) Then sss = sss & IIf(Right$(ss, 1) = "1", "а", "ы") End If End If End If If Not IsMissing(Seconds) Then Seconds = DateDiff(s, ds, d2) If ReturnString Then ss = Right$(Format$(Seconds, "00"), 2) If Len(sss) Then sss = sss & sr sss = sss & Seconds & " секунд" If Not (Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5) Then sss = sss & IIf(Right$(ss, 1) = "1", "а", "ы") End If End If End If If ReturnString Then DateInterval = sss End Function

**Vladimir!** » 04.10.2005 (Вт) 21:05

Всем огрооомное спасибо! Выручили!

Конференция VBStreets

Работа с датами

Работа с датами

Кто сейчас на конференции