saadeps قام بنشر أغسطس 30, 2016 قام بنشر أغسطس 30, 2016 Book1.rar عفوا لم انتبه كنت اقصد الاسماء المذكرة عن الاسماء المؤنثة
أبو سجده قام بنشر أغسطس 30, 2016 قام بنشر أغسطس 30, 2016 السلام عليكم يمكنك اولا تحديد النوع من خلال الرقم القومى أفضل من عملية الاختيار من خلال القائمة المنسدلة ومن ثم تتم عملية فرز وترحيل الاسماء كما تشاء إن كان الامر يروقك فعلى الرحب والسعة جزاكم الله خيرا 1
أبو سجده قام بنشر أغسطس 31, 2016 قام بنشر أغسطس 31, 2016 حاجة كمان زى بعضه ناكل عيالنا هناك من الاسماء المشتركة بين الذكور والاناث إسلام **** عصمت **** نور **** رجاء **** إيمان ***** وهكذا وهناك من الاسماء التى بها إختلاط فى تشكيل الحروف بشرى مرة بضم الباء " أنثى " وبكسر الباء " ذكر " **** وهكذا الفاصل الوحيد للوصول لنتائج 100% هو الرقم القومى جزاكم الله خيرا 1
ياسر خليل أبو البراء قام بنشر أغسطس 31, 2016 قام بنشر أغسطس 31, 2016 أخي الكريم ساديب يرجى تغيير اسم الظهور للغة العربية والإطلاع على التوجيهات في الموضوعات المثبتة في صدر المنتدى (بالله عليكم التزموا بالتعليمات .. والكلام موجه للجميع وليس لشخص واحد فقط) أخي الغالي أبو عبد الرحمن اقتراحك رائع جداً ولكن نحن نتعامل مع واقع الملف ومن الملف يوجد عمود يحدد النوع ، إذاً ليست القضية في المذكر والمؤنث مشكلة .. تكون مشكلة وقضية حينما يطلب أحدهم من الإكسيل تخمين النوع (ودا ساعتها نديله على نافوخه .. هو مفكر الإكسيل سعادته سجل مدني !!) أخي الحبيب سليم راجع ملفك فالنتائج غير مكتملة نظراً لأن المعادلات ينقصها رقم 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 تقبلوا جميعاً تحياتي 3
سليم حاصبيا قام بنشر أغسطس 31, 2016 قام بنشر أغسطس 31, 2016 (معدل) منذ ساعه, ياسر خليل أبو البراء 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 تم تعديل أغسطس 31, 2016 بواسطه سليم حاصبيا 4
saadeps قام بنشر أغسطس 31, 2016 الكاتب قام بنشر أغسطس 31, 2016 (معدل) السلام عليكم بارك الله فيك استاذ سليم لقد نزلت الملف الاول ووجدت فيه نقص بينما اعالج ذلك النقص اذ بردك يصل الي سبحان الله وكأنك قرأت افكاري وما اريده المهم انه المطلوب بالضبط شكرا لك وللاستاذ ياسر وكذلك ابو عبد الرحمان على اهتامامكم جعل الله ما تقدمونه في ميزان حسناتكم تم تعديل أغسطس 31, 2016 بواسطه saadeps
ياسر خليل أبو البراء قام بنشر أغسطس 31, 2016 قام بنشر أغسطس 31, 2016 جزيت خيراً أخي الحبيب سليم على الملف الأخير .. فكرته جميلة وإن كنت لا أحبذ شخصياً التعامل مع الـ Advanced Filter ... ربما لأنه ينشيء نطاقات باسم Extract و Criteria (هذا ما يضايقني فيه) عموماً الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات تقبل تحياتي 1
saadeps قام بنشر أغسطس 31, 2016 الكاتب قام بنشر أغسطس 31, 2016 (معدل) استاذ سليم من فضلك هل يمكن ان تضع فيديو عن طريقة عملك لهذا الملف طبعا ان كانت صلاحيات الموقع تسمح بهذا لاني حاولت ان افهم طريقة العمل وحاولت اعادتها لكن لم افلح في ذلك وهذا لكي استعملها في مصنفات اخرى وياحبذا لو تعلمني ايضا كيف اطبق الكود على عدة اوراق عمل بارك الله فيكم جميعا تم تعديل أغسطس 31, 2016 بواسطه saadeps
سليم حاصبيا قام بنشر أغسطس 31, 2016 قام بنشر أغسطس 31, 2016 4 ساعات مضت, saadeps said: استاذ سليم من فضلك هل يمكن ان تضع فيديو عن طريقة عملك لهذا الملف طبعا ان كانت صلاحيات الموقع تسمح بهذا لاني حاولت ان افهم طريقة العمل وحاولت اعادتها لكن لم افلح في ذلك وهذا لكي استعملها في مصنفات اخرى وياحبذا لو تعلمني ايضا كيف اطبق الكود على عدة اوراق عمل بارك الله فيكم جميعا للاسف ليس لدي الخبرة الكافية لتسجيل فيدبوهات (اذ لم امارس هذا الشيء مسبقاً) اذا كان عندك اي عنوان لاي موقع يقوم بتعليم هذا الشيئ الرجاء كتابته
saadeps قام بنشر أغسطس 31, 2016 الكاتب قام بنشر أغسطس 31, 2016 (معدل) تفضل استاذي الفاضل رابط البرنامج تحت الفيديو في اليوتوب تم تعديل أغسطس 31, 2016 بواسطه saadeps
ابو عبدالبارى قام بنشر أغسطس 31, 2016 قام بنشر أغسطس 31, 2016 اخوانى الأعزاء واثراءا للموضوع 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 1
saadeps قام بنشر أغسطس 31, 2016 الكاتب قام بنشر أغسطس 31, 2016 الى الاستاذ عبد الباري ارجو ان تراجع هذا الملف Book1.rar
ابو عبدالبارى قام بنشر سبتمبر 2, 2016 قام بنشر سبتمبر 2, 2016 الأخ الكريمsaadeps جرب المرفق التالى لعلة يكون المطلوب abo_abary_Book1 (2).rar
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.