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

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

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

إخواني الكرام .. لاحظت أن كل فترة يتم السؤال عن هذا الأمر ..

هذا الموضوع يخص الأرقام القومية في مصر ، وقد تم تناول الموضوع أكثر من مرة .. واطلعت على أكثر من موضوع بهذا الشأن ، فما وجدت أفضل ولا أيسر ولا أخف من دالة الأستاذ الكبير / عبد الله باقشير ، دالة يسيرة وسهلة ، ويمكنك ببساطة استخراج كل المعلومات والبيانات التي تريدها من خلال هذه الدالة ..

الشكر الكبير موصول للأستاذ الكبير والعالم الجليل عبد الله باقشير .. نرجو من الله أن يحفظه من كل سوء ..

الدالة في محرر الأكواد بهذا الشكل :

(للدخول على محرر الأكواد اضغط من لوحة المفاتيح Alt + F11)

Option Explicit
'           بسم الله الرحمن الرحيم
'           ********************
'            دالـــــــــــــــة
'           Kh_Date_Sex_Province
'  ( استخراج تاريخ الميلاد او النوع (ذكر - انثى
'       او المحافظة من الرقم القومي
'==============================================
'                  MyTest
'    اذا كانت = 1  تقوم باستخراج تاريخ الميلاد
'          اذا كانت = 2  تقوم باستخراج النوع
'         اذا كانت = 3  تقوم باستخراج المحافظة
'----------------------------------------------
'         MyProvinces  في متغير الجدول
'   بنفس الطريقة الرقم اولا ثم "/" ثم اسم المحافظة
'                             :  مثال على ذلك
'               "01/القاهرة"
'==============================================
Function Kh_Date_Sex_Province(MyNumber As Variant, MyTest As Byte)
Dim MyProvinces As Variant
Dim r As Integer
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/البحر الأحمر")
'==============================================
Kh_Date_Sex_Province = ""
On Error GoTo 1
If Len(Trim(MyNumber)) = 0 Then
    GoTo 1
End If
If Not IsNumeric(MyNumber) Or Len(MyNumber) <> 14 Then
    Kh_Date_Sex_Province = ""
    GoTo 1
End If
If MyTest = 1 Then
    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 = y
        Case "3": yy = "20" & y
        Case Else: yy = ""
    End Select
    If yy <> "" Then Kh_Date_Sex_Province = DateSerial(yy, m, d)
ElseIf MyTest = 2 Then
    If Left(Right(MyNumber, 2), 1) Mod 2 = 1 Then _
    yy = "ذكر" Else yy = "أنثى"
    Kh_Date_Sex_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_Sex_Province = Right(MyProvinces(r), Len(MyProvinces(r)) - 3)
            Exit For
        End If
    Next
End If
1:
End Function

كل ما أضفته في الكود هو أكواد باقي المحافظات ، ليكتمل العمل ويستفيد منه الجميع بإذن الله

أترككم مع الملف المرفق ، لتتعلموا منه طريقة استخراج البيانات....

دمتم في طاعة الله و السلام هو مسك الختام

ID Information.rar

[ابو بهاء المصري]

اعمال رائعة لاشخاص رائعون 

بارك الله فيكم

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

مشكور أخي الفاضل أبو بهاء المصري

بارك الله فيك على مرورك العطر

[محي الدين ابو البشر]

بارك الله بك استاذ ياسر

كل افكارك ساحرة وتثلج القلب

اذا سمحت لي بسؤال: بالنسبة للمصفوفة MyProvinces هل من الممكن أن نضح اسماء المحافظات في جدول ومن ثم يتم قراءة عناصر المصفوفة إلى MyProvinces بدل من كتابتها في الكود ذاته

مجر سؤال للمعرفة

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

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

أعتقد أنه من الممكن عمل ذلك .. ولكن ما الداعي لعمل ذلك ؟

بالعكس أعتقد أن هذا أفضل ، بذلك تستغني عن ورقة العمل ، ويمكنك استخدام الكود في أي مصنف بدون الاضطرار إلى نسخ الجدول مع كل مصنف ستقوم باستخدام الكود فيه

[محي الدين ابو البشر]

عذراً منك استاذ ياسر

شكراً لك على ردك وكلامك صحح مئة بالمئة

ولكن السؤال كان من فقط لتعلم الطريقة و استخدام الكود في مجال آخر ليس إلا

[Yasser Fathi Albanna]

مش عارف أقولك إيه يا أخى العزيز / ياسر خليل

بالفعل انا بقالى كام يوم غائب عن المنتدى لإنشغالى بشغلى

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

جزاك الله خيرا

[ahmd_asd4]

و إثراء الموضوع أيضا هذا حل بالمعادلات وهو لأحد الأخوة الأعضاء

حساب السن و المحافظةو تاريخ الميلاد.rar

[ناصر سعيد]

جزاكم الله خيرا

[احمد ابوزيزو]

يمكن

اضافة الكود 88

للمواليد والمقيدين خارج مصر ( السفارات والقنصليات )

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

موجود في الكود .. ومشكور على مرورك العطر أخي أحمد أبو زيزو

[احمد ابوزيزو]

الاستاذ / ياسر ابو خليل

ارجو قبول اعتذاري

لكن العتب علي النظر

والحمد لله رب العالمين

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

أخي الحبيب لا داعي للاعتذار

اللي بيغلط هنا بيدفع غرامة غلط !! ههه

والغرامة حاجة ساقعة لكل الأعضاء الليلة (دا أقل واجب)

 

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

تقبل تحياتي