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

[ياسر خليل أبو البراء]

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

إخواني وأحبابي في الله

الموضوع ليس بجديد ولكن عند إطلاعي على الموضوع القديم ووجدت بعض القصور في أكواد المحافظات وإضافة التحقق من صحة المدخلات ..فقمت بالتعديل على الدالة المعرفة ، والأصل في الدالة أنها للعلامة الكبير عبد الله باقشير ولكن تم التعديل عليها لتتلافى الأخطاء التي كانت في الإصدار السابق

إليكم الدالة المعرفة .... والدالة المعرفة User Defined Function توضع في موديول ويمكن بعدها استخدامها كدوال الإكسيل العادية

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

أرجو أن ينال الموضوع إعجابكم إن شاء الله

تقبلوا تحياتي

 

حمل الملف من هنا  

 

 

[محمد حسن المحمد]

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

عمل ومجهود كبير ..جزاكم الله خيراً أخي الحبيب أبو البراء

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

والفكرة الأدهى كيف أمكنهم تكوين "تركيب مكوناته من تاريخ ميلاد وجنس مولود ومحافظة"..

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

[ابن بنها]

نشكر الاخ النشيط ياسر لعمله الدي ندعو الله ان يجعله خالصا لوجه الله الكريم وبعد

اخي ياسر ماهو القصور الذي وجدته في الداله الاولى خاصة الاستاذ عبد الله باقشير

واين اضافتك ... لك شكري

[أبوبسمله]

جزاك الله كل خير يا ابو البراء

تسلم ايدك وايد العلامه عبدالله باقشير

تقبل تحياتى العطره بذكر الرحمن ومرورى حبيبى الغالى

[ياسر خليل أبو البراء]

أخي الغالي أبو يوسف

وعليكم السلام

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

 

أخي الكريم ابن بنها

القصور الذي وجدته في الدالة الأولى وهو ليس بقصور بمعنى الكلمة ولكن قمت بتهذيب الدالة فقد قمت بإضافة كل الأكواد الخاصة بالمحافظات وأمر آخر .. عند التعامل مع الدالة الأولى مع رقم غير صحيح كان يعطي نتائج غير صحيحة فتمت إضافة شروط للتحقق من صحة الرقم القومي بشكل كامل ..أما الإضافات بالضبط فلا أتذكرها كلياً .. يمكنك البحث عن الدالة الأصلية للعلامة عبد الله باقشير وضع الدالتين بجوار بعضهما البعض وقارن بينهما لتعرف الاختلاف والإضافات

 

أخي الغالي أحمد الفلاحجي

جزيت خيراً بمثل ما دعوت لي وشاكر مرورك العطر بالموضوع

تقبلوا تحياتي

[ابن بنها]

 

[ياسر خليل أبو البراء]

أخي الكريم ابن بنها

وجزيت خيراً بمثل ما دعوت لنا ..

تقبل تحياتي

[ياسر خليل أبو البراء]

بارك الله فيكم إخواني وجزاكم الله خيراً على مروركم العطر بالموضوع

لو فيه أي حد جرب الدالة المعرفة ووجد أي مشكلة بها فليبلغنا بها حتى تكتمل الدالة بصورة كاملة إن شاء الله

فالكل هنا يكمل بعضه البعض ، وكلنا نتعلم من بعضنا البعض ... وفوق كل ذي علمٍ عليم

تقبلوا فائق احترامي