إجمالي مرات مشاهدة الصفحة

الاثنين، 25 أبريل 2016

استخراج تاريخ الميلاد والنوع ومحافظة الميلاد من الرقم القومي Birth Date Gender Province UDF Function

السلام عليكم ورحمة الله وبركاته

أقدم لكم دالة معرفة User-Defined Function تقوم باستخراج تاريخ الميلاد والنوع ومحافظة الميلاد من الرقم القومي (لدولة مصر حيث الرقم القومي مكون من 14 رقم).

استخدام الدالة :
قم بوضع الدالة المعرفة في موديول عادي ثم انتقل لورقة العمل لكتابة المعادلات
بفرض أن الرقم القومي موجود في الخلية A2 ، قم بكتابة المعادلة التالية في الخلية B2 لاستخراج تاريخ الميلاد

=Kh_Date_Gender_Province(A2,1)

والمعادلة التالية لتحديد النوع (ذكر أو أنثى) ضعها في الخلية C2

=Kh_Date_Gender_Province(A2,2)

والمعادلة التالية في الخلية D2 لاستخراج محافظة الميلاد من الرقم القومي وهي بالشكل التالي

=Kh_Date_Gender_Province(A2,3)

وأخيراً إليكم الدالة المعرفة وتوضع كما ذكرنا في موديول عادي :

Function Kh_Date_Gender_Province(MyNumber As Variant, MyTest As Byte)
    Dim MyProvinces As Variant
    Dim R As Long
    Dim YY As String
    Dim TY As String * 1
    Dim D As String * 2, M As String * 2, Y As String * 2, X As String * 2, XX As String * 2
    
    MyProvinces = Array("01/القاهرة", "02/الإسكندرية", "12/الدقهلية", "13/الشرقية", "14/القليوبية", "15/كفر الشيخ", "16/الغربية", "17/المنوفية", "18/البحيرة", "19/الإسماعيلية", "21/الجيزة", "22/بني سويف", "24/المنيا", "25/أسيوط", "26/سوهاج", "27/قنا", "28/أسوان", "29/الأقصر", "33/مطروح", "23/الفيوم", "88/خارج الجمهورية", "11/دمياط", "04/السويس", "03/بورسعيد", "34/شمال سيناء", "35/جنوب سيناء", "32/الوادي الجديد", "31/البحر الأحمر")
    
    D = Mid(MyNumber, 6, 2)
    M = Mid(MyNumber, 4, 2)
    Y = Mid(MyNumber, 2, 2)
    TY = Left(MyNumber, 1)
    
    Select Case TY
        Case "2": YY = "19" & Y
        Case "3": YY = "20" & Y
        Case Else
    End Select

    Kh_Date_Gender_Province = ""
    On Error GoTo 1
   
    If Not IsNumeric(MyNumber) Or Len(MyNumber) <> 14 Or Len(Trim(MyNumber)) = 0 _
    Or Val(M) < 1 Or Val(M) > 12 Or (Val(TY) <> 2 And Val(TY) <> 3) Or Month(DateSerial(YY, M, D)) <> Val(M) Then
            Kh_Date_Gender_Province = ""
            GoTo 1
    End If
    
    If MyTest = 1 Then
        If YY <> "" Then Kh_Date_Gender_Province = DateSerial(YY, M, D)
    ElseIf MyTest = 2 Then
        If Left(Right(MyNumber, 2), 1) Mod 2 = 1 Then YY = "ذكر" Else YY = "أنثى"
        Kh_Date_Gender_Province = YY
    ElseIf MyTest = 3 Then
        X = Mid(MyNumber, 8, 2)
        For R = LBound(MyProvinces) To UBound(MyProvinces)
            XX = MyProvinces(R)
            If X = XX Then
                Kh_Date_Gender_Province = Right(MyProvinces(R), Len(MyProvinces(R)) - 3)
                Exit For
            End If
        Next
    End If
1: End Function

إعداد / ياسر خليل أبو البراء

هناك 5 تعليقات:

  1. الله ينور عليك ومجهود تشكر عليه اللهم اجعله فى ميزان حساناتك

    ردحذف
  2. اللهم آمين بارك الله فيك على دعائك الطيب

    ردحذف
  3. جزاكم الله كل الخير عنا

    ردحذف
  4. وجزيت أخي العزيز بمثل ما دعوت لي وزيادة

    ردحذف
  5. السلام عليكم ورحمة الله وبركاته

    أليست هذه دالة الاستاذ عبدالله باقشير
    خبورخير
    لماذا لا تنسب الدالة اليه

    ردحذف