Лет, месяцев, дней

[blinow]

Случайно нет ли у кого формулы расчета сколько прошло лет, месяцев, дней.
Свою потерял, помню что-то, типа 1061012-647021 получается разность и первые две цифры лет, а далее не помню.
А числа это дата наоборот. 21.01.2006 и 12.07.1964.

[blinow]

Сам нашел, может кому надо, то пожалуйста. Писал очень давно, так, что не очень красиво но работает.

Код: Выделить всё

Public Function Stav(dat As Date, na_dat As Date)
  Dim ss As String
  Dim ddd As Double
  Dim na_ddd As Double
  Dim dd As String
  Dim mm As String
  Dim gg As String
  Dim w As Double
  Dim w1 As Double
  Dim wg As Integer
  Dim wm As Integer
  Dim wd As Integer
  Dim w_p As String
  Dim wg_p As String
  Dim wm_p As String
  Dim wd_p As String
  Dim i As Integer
  Dim t As Integer
  Dim prom As String
  Dim f_m As Boolean
  Dim f_d As Boolean
  Dim return_m(3) As Variant

  gg = Mid(LTrim(Str(Year(na_dat))), 3, 2)
  If Year(na_dat) > 1999 Then
    gg = "1" & gg
  End If
  mm = IIf(Month(na_dat) < 10, "00" + LTrim(Str(Month(na_dat))), "0" + LTrim(Str(Month(na_dat))))
  dd = IIf(Day(na_dat) < 10, "00" + LTrim(Str(Day(na_dat))), "0" + LTrim(Str(Day(na_dat))))
  ss = LTrim(gg) + LTrim(mm) + LTrim(dd)
  na_ddd = Val(ss) / 1000000

 
  gg = Mid(LTrim(Str(Year(dat))), 3, 2)
  If Year(dat) > 1999 Then
    gg = "1" & gg
  End If
  mm = IIf(Month(dat) < 10, "00" + LTrim(Str(Month(dat))), "0" + LTrim(Str(Month(dat))))
  dd = IIf(Day(dat) < 10, "00" + LTrim(Str(Day(dat))), "0" + LTrim(Str(Day(dat))))
  ss = LTrim(gg) + LTrim(mm) + LTrim(dd)
  ddd = Val(ss) / 1000000
 
  w = na_ddd - ddd
  w1 = w
  w_p = Format(w, "###0.000000")
  t = 0
  For i = 1 To Len(w_p)
    prom = Mid(w_p, i, 1)
    If prom = "." Or prom = "," Then
      Exit For
    End If
  Next i
  t = i
  wg_p = IIf(t = 1, "0", Mid(w_p, 1, t - 1))
  f_m = False
  f_d = False
  If Mid(w_p, t + 1, 1) = 9 Then
    f_m = True
  End If
  If Mid(w_p, t + 1, 2) = 9 Then
    f_m = True
  End If
  If Mid(w_p, t + 1 + 3, 1) = 9 Then
    f_d = True
  End If
  If Mid(w_p, t + 1 + 3, 2) = 9 Then
    f_d = True
  End If
  If f_m And f_d Then
    w = w - 0.98897
  End If
  If f_m And (Not f_d) Then
    w = w - 0.988
  End If
  If (Not f_m) And f_d Then
    w = w - 0.00097
  End If
  w_p = Format(w, "###0.000000")
  wm_p = Mid(w_p, t + 1, 3)
  wd_p = Mid(w_p, t + 1 + 3, 3)
 
  return_m(1) = Val(wg_p)
  return_m(2) = Val(wm_p)
  return_m(3) = Val(wd_p)
  return_m(0) = wg_p + "," + wm_p + "," + wd_p
  MsgBox ("Лет= " & return_m(1) & Chr(10) & "Месяцев= " & return_m(2) & Chr(10) & "Дней= " & return_m(3))
End Function
Private Sub vvv()
    Call Стаж(CDate("12.07.1964"), Date)
End Sub


[GSerg]

Не нашёл он. Загляни в кирпичи сначала. Специально выложено там.

[Naked]

а так не подходит?
Dim nDay, nMonth, nYear

Private Sub Form_Click()
nDay = DateDiff("d", "01.01.2006", "15.05.2010")
nMonth = DateDiff("m", "01.01.2006", "15.05.2010")
nYear = DateDiff("yyyy", "01.01.2006", "15.05.2010")


Caption = "Day: " & nDay & " Month: " & nMonth & " Year: " & nYear
End Sub

[GSerg]

Naked
Выполни ? datediff("yyyy","31.12.2005", "01.01.2006")

[Naked]

нну, год возвратил

[Amed]

А целых лет прошло 0. Неувязочка.

[blinow]

Во первых эту функцию я писал еще студентом на ДВК и там вообще типа Date не существовало, а уж о DateDiff и говорить нечего.
Во вторых Вы что, никогда не сталкивались с таким заданием?
В отделах кадров требуется стаж вычислять именно Лет, Месяцев, Дней или человек считается дитем когда ему 17 лет 11 месяцев и 29 дней, а 17 лет 11 месяцев и 30 дней уже взрослый.
И в третьих ну че эта DateDiff выдает? Разобраться конечно можно, но та формула работает уже лет 50 и выдает что, нужно без проблем.

[Amed]

Код: Выделить всё

Dim d1 As Date, d2 As Date

d1 = DateAdd("yyyy", 17, Now)
d1 = DateAdd("m", 11, d1)
d1 = DateAdd("d", 29, d1)

d2 = DateAdd("yyyy", 17, Now)
d2 = DateAdd("m", 11, d2)
d2 = DateAdd("d", 30, d2)

MsgBox DateDiff("d", d2, d1)

Не проверял, должно работать. Выдает разницу в днях между d1 и d2.

[Vladimir!]

http://bbs.vbstreets.ru/viewtopic.php?t ... 2%E0%CC%C8[/url]