قد تم التعديل من قبل استاذنا الكبير ابراهيم الحداد فى المشاركة الأخرى له منا جميعا كل المحبة والإحترام
Sub DatedIf_User()
Dim ws As Worksheet, Sh As Worksheet, Mh As Worksheet
Dim ShName As String, Rng As Range, C As Range
Dim LR As Long, VlDate As Variant
Application.ScreenUpdating = False
Set ws = Sheets("بيانات الطالبات")
VlDate = ws.Range("I5").Value
'----------------------------------
LR = ws.Cells(Rows.Count, "E").End(xlUp).Row
If LR < 8 Then Exit Sub
ws.Range("I8:K" & LR + 1).ClearContents
Set Rng = ws.Range("H8:H" & LR)
'----------------------------------
If IsEmpty(VlDate) = True Then
MsgBox "من فضلك ادخل تاريخ حساب السن"
Exit Sub
Else
On Error Resume Next
For Each C In Rng
If C.Value <> "" Then
YY = Year(VlDate)
y = Year(C.Value)
mm = Month(VlDate)
m = Month(C.Value)
dd = Day(VlDate)
D = Day(C.Value)
'-----------------------
If D > dd And m > mm Then
C.Offset(0, 1) = dd + 30 - D
C.Offset(0, 2) = mm - m + 11
C.Offset(0, 3) = YY - y - 1
'-----------------------
ElseIf D <= dd And m > mm Then
C.Offset(0, 1) = dd - D
C.Offset(0, 2) = mm - m + 12
C.Offset(0, 3) = YY - y - 1
'-----------------------
ElseIf D >= dd And m = mm Then
C.Offset(0, 1) = dd - D + 30
C.Offset(0, 2) = mm - m + 11
C.Offset(0, 3) = YY - y - 1
'-----------------------
ElseIf D >= dd And m < mm Then
C.Offset(0, 1) = dd - D + 30
C.Offset(0, 2) = mm - m - 1
C.Offset(0, 3) = YY - y
'-----------------------
Else
C.Offset(0, 1) = dd - D
C.Offset(0, 2) = mm - m
C.Offset(0, 3) = YY - y
End If
End If
Next
End If
Application.ScreenUpdating = True
End Sub