اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

أساتذي الكرام المطلوب استخراج تاريخ الميلاد والنوع من الرقم القومي وحساب السن بأكواد VBA وليس معادلات أو دالة وظهور النتيجة كقيم

استخراج تاريخ الميلاد والنوع وحساب السن كقيم.xls

قام بنشر

ألف شكر على مجهودك وتعبك ولكن عند إضافة أسماء اخرى لا تعمل

وعلى فكرة أستاذنا ومعلمنا الفاضل الأستاذ / إبراهيم الحداد قام بعمل حساب التاريخ في ملف الصف الثاني تجاري بواسطة ماكرو VBA فياريت نصل إلى استخراج تاريخ الميلاد في ماكرو مستقل والنوع في ماكرو آخر 

قام بنشر

هذا هو كود تحديد السن المطلوب

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(ActiveSheet.Name)
VlDate = ws.Range("K4").Value
 '----------------------------------
LR = ws.Cells(Rows.Count, "C").End(xlUp).Row
ws.Range("J6:L" & LR + 1).ClearContents
Set Rng = ws.Range("I6:I" & 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 + 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



 

 

  • Like 1
قام بنشر

تسلم الأنامل أستاذ إبراهيم  ولكن بقي شرط حتى يكتمل الموضوع وتعم الفائدة

الشرط هو أن نكتب المعادلة التالية إذا لم يتحقق تكون النتيجة تأكد من الرقم القومي

=IF(AND(LEN(C4)<>14;ISNUMBER((C4)));"خطأ")

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information