اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

فصل الاسماء المذكرة عن المؤنثة (فصل الذكور عن الإناث)


saadeps

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

السلام عليكم

يمكنك اولا تحديد النوع من خلال الرقم القومى أفضل من عملية الاختيار من خلال القائمة المنسدلة

ومن ثم تتم عملية فرز وترحيل الاسماء  كما تشاء 

إن كان الامر يروقك فعلى الرحب والسعة

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

 

  • Like 1
رابط هذا التعليق
شارك

حاجة كمان زى بعضه ناكل عيالنا

هناك من الاسماء المشتركة بين الذكور والاناث

إسلام **** عصمت **** نور **** رجاء  **** إيمان  *****  وهكذا

وهناك من الاسماء التى بها إختلاط فى تشكيل الحروف  

بشرى مرة بضم الباء " أنثى " وبكسر الباء " ذكر " **** وهكذا

الفاصل الوحيد للوصول لنتائج 100% هو الرقم القومى

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

 

  • Like 1
رابط هذا التعليق
شارك

أخي الكريم ساديب

يرجى تغيير اسم الظهور للغة العربية والإطلاع على التوجيهات في الموضوعات المثبتة في صدر المنتدى (بالله عليكم التزموا بالتعليمات .. والكلام موجه للجميع وليس لشخص واحد فقط)

أخي الغالي أبو عبد الرحمن

اقتراحك رائع جداً ولكن نحن نتعامل مع واقع الملف ومن الملف يوجد عمود يحدد النوع ، إذاً ليست القضية في المذكر والمؤنث مشكلة .. تكون مشكلة وقضية حينما يطلب أحدهم من الإكسيل تخمين النوع (ودا ساعتها نديله على نافوخه .. هو مفكر الإكسيل سعادته سجل مدني !!)

أخي الحبيب سليم

راجع ملفك فالنتائج غير مكتملة نظراً لأن المعادلات ينقصها رقم 0 بجانب C10 لتصبح C100 والمعادلات في العمود H معادلات صفيف يبدو أنك نسيت الضغط على المفاتيح بشكل صحيح ..عموماً هي هفوات بسيطة ولكن المعادلات رائعة وفي منتهى الجمال وتؤدي الغرض

وإثراءً للموضوع يمكن استخدام الكود التالي (مع العلم أن هناك طرق أخرى كالفلترة أو استخدام المصفوفات .. ولكن استخدمت هنا الحلقات التكرارية .. تقليدي في الموضوع)

Sub Test()
    Dim Lr As Long, lastMale As Long, lastFemale As Long, I As Long

    Application.ScreenUpdating = False
        With ActiveSheet
            .Range("H3:K1000").ClearContents
            Lr = .Cells(Rows.Count, 2).End(xlUp).Row
    
            For I = 3 To Lr
                If .Cells(I, 3).Value = "ذكر" Then
                    lastMale = .Cells(Rows.Count, "H").End(xlUp).Row + 1
                    .Range("H" & lastMale).Value = .Cells(I, 2).Value
                    .Range("H" & lastMale).Offset(0, 1).Value = .Cells(I, 4).Value
                ElseIf .Cells(I, 3).Value = "انثى" Then
                    lastFemale = .Cells(Rows.Count, "J").End(xlUp).Row + 1
                    .Range("J" & lastFemale).Value = .Cells(I, 2).Value
                    .Range("J" & lastFemale).Offset(0, 1).Value = .Cells(I, 4).Value
                End If
            Next I
        End With
    Application.ScreenUpdating = True
End Sub

تقبلوا جميعاً تحياتي

  • Like 3
رابط هذا التعليق
شارك

منذ ساعه, ياسر خليل أبو البراء said:

أخي الكريم ساديب

يرجى تغيير اسم الظهور للغة العربية والإطلاع على التوجيهات في الموضوعات المثبتة في صدر المنتدى (بالله عليكم التزموا بالتعليمات .. والكلام موجه للجميع وليس لشخص واحد فقط)

أخي الغالي أبو عبد الرحمن

اقتراحك رائع جداً ولكن نحن نتعامل مع واقع الملف ومن الملف يوجد عمود يحدد النوع ، إذاً ليست القضية في المذكر والمؤنث مشكلة .. تكون مشكلة وقضية حينما يطلب أحدهم من الإكسيل تخمين النوع (ودا ساعتها نديله على نافوخه .. هو مفكر الإكسيل سعادته سجل مدني !!)

أخي الحبيب سليم

راجع ملفك فالنتائج غير مكتملة نظراً لأن المعادلات ينقصها رقم 0 بجانب C10 لتصبح C100 والمعادلات في العمود H معادلات صفيف يبدو أنك نسيت الضغط على المفاتيح بشكل صحيح ..عموماً هي هفوات بسيطة ولكن المعادلات رائعة وفي منتهى الجمال وتؤدي الغرض

وإثراءً للموضوع يمكن استخدام الكود التالي (مع العلم أن هناك طرق أخرى كالفلترة أو استخدام المصفوفات .. ولكن استخدمت هنا الحلقات التكرارية .. تقليدي في الموضوع)


Sub Test()
    Dim Lr As Long, lastMale As Long, lastFemale As Long, I As Long

    Application.ScreenUpdating = False
        With ActiveSheet
            .Range("H3:K1000").ClearContents
            Lr = .Cells(Rows.Count, 2).End(xlUp).Row
    
            For I = 3 To Lr
                If .Cells(I, 3).Value = "ذكر" Then
                    lastMale = .Cells(Rows.Count, "H").End(xlUp).Row + 1
                    .Range("H" & lastMale).Value = .Cells(I, 2).Value
                    .Range("H" & lastMale).Offset(0, 1).Value = .Cells(I, 4).Value
                ElseIf .Cells(I, 3).Value = "انثى" Then
                    lastFemale = .Cells(Rows.Count, "J").End(xlUp).Row + 1
                    .Range("J" & lastFemale).Value = .Cells(I, 2).Value
                    .Range("J" & lastFemale).Offset(0, 1).Value = .Cells(I, 4).Value
                End If
            Next I
        End With
    Application.ScreenUpdating = True
End Sub

تقبلوا جميعاً تحياتي

لمزيد من التميُّز 

احي ياسر انظر الى الورقة salim من هذا الملف

تم تصحيح المعادلات في الورقة الاولى

male_femel_macro.rar

تم تعديل بواسطه سليم حاصبيا
  • Like 4
رابط هذا التعليق
شارك

السلام عليكم

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

لقد نزلت الملف الاول ووجدت فيه نقص

بينما اعالج ذلك النقص اذ بردك يصل الي

سبحان الله وكأنك قرأت افكاري وما اريده

المهم انه المطلوب بالضبط شكرا لك وللاستاذ ياسر وكذلك ابو عبد الرحمان على اهتامامكم

جعل الله ما تقدمونه في ميزان حسناتكم

 

 

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

جزيت خيراً أخي الحبيب سليم على الملف الأخير .. فكرته جميلة وإن كنت لا أحبذ شخصياً التعامل مع الـ Advanced Filter ... ربما لأنه ينشيء نطاقات باسم Extract و Criteria (هذا ما يضايقني فيه)

عموماً الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات

تقبل تحياتي

 

  • Like 1
رابط هذا التعليق
شارك

استاذ سليم

من فضلك هل يمكن ان تضع فيديو عن طريقة عملك لهذا الملف

طبعا ان كانت صلاحيات الموقع تسمح بهذا

لاني حاولت ان افهم طريقة العمل وحاولت اعادتها  لكن لم افلح في ذلك

وهذا لكي استعملها في مصنفات اخرى

وياحبذا لو تعلمني ايضا كيف اطبق الكود على عدة اوراق عمل

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

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

4 ساعات مضت, saadeps said:

استاذ سليم

من فضلك هل يمكن ان تضع فيديو عن طريقة عملك لهذا الملف

طبعا ان كانت صلاحيات الموقع تسمح بهذا

لاني حاولت ان افهم طريقة العمل وحاولت اعادتها  لكن لم افلح في ذلك

وهذا لكي استعملها في مصنفات اخرى

وياحبذا لو تعلمني ايضا كيف اطبق الكود على عدة اوراق عمل

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

للاسف ليس لدي الخبرة الكافية لتسجيل فيدبوهات (اذ لم امارس هذا الشيء مسبقاً)

اذا كان عندك اي عنوان لاي موقع يقوم بتعليم هذا الشيئ الرجاء كتابته  

رابط هذا التعليق
شارك

اخوانى الأعزاء

واثراءا للموضوع

Private Sub mh()
 m = 2: n = 2
 For R = 3 To 12
              If Cells(R, 3) = "ÐßÑ" Then
                 m = m + 1
     Range("A" & R).Range("b1:d1").Copy
             Range("h" & m).PasteSpecial xlPasteValues
             Range("g" & m) = m - 2
                      Application.CutCopyMode = False
                 ElseIf Cells(R, 3) = "ÇäËì" Then
                   n = n + 1
     Range("A" & R).Range("b1:d1").Copy
           Range("k" & n).PasteSpecial xlPasteValues
           Range("g" & n) = (n - 2)
             Application.CutCopyMode = False
             End If
    Next
End Sub

 

 

 

abo_abary_Book1.rar

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information