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

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

الاجابة هى :

باستخدام دالة معرفة 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