محمد ابو البـراء قام بنشر يونيو 12, 2013 قام بنشر يونيو 12, 2013 (معدل) السلام عليكم ورحمة الله وبركاته وبعد كنت قد عرضت موضوع اطلب فيه عمل قاعدة لمشروع الخبز ومحاولة الحد من التزوير باخراج الارقام القومية المكررة وجزى الله الاخوة المساعدين لي لاتمام العمل الاستاذ/ جمال عبد السميع الاستاذ / رجب جاويش الاستاذ / سعيد بيرم الاستاذ / ضاحي الغريب ولمراجعة الموضوع على هذا الرابط http://www.officena.net/ib/index.php?showtopic=47525 ولكن المشكلة ان الاعمال التي ارسلها الاخوة الفضلاء ممتازة ولكن لمشرع لم يتم كتابة الاسماء ولكن نحن قد انتهينا من العمل بالفعل و نريد اخراج الارقام المكررة والطرق التي يتم معرفة الارقام بها سواء كانت بطريقة التلوين الشرطي لتلوين خلية الارقام المكررة صعبة في البحث عنها في وسط 35000 رقم . ولهذا جائتني فكرة وهي ما جعلتني اكتب هذا الموضوع الفكرة هي الترحيل بمعني اننا ممكن ان نكتب البيانات جميعها بشكل عادي ويتم بعدها ترحيل الارقام المكررة في ورقة أخرى فيسهل على ذلك جمع الاسماء المكررة في مكان واحد بدلاً من ان نقوم بالبحث عنها وسط 35000 اسم فاتمني ان احد يساعدنا في ارسال كود يقوم بترحيل صف الارقام المكررة في عمود الرقم القومي ولقد تركتم لكم ملف مرفق لجزء من العمل ليتم التامل معه ترحيل الارقام المكررة.rar تم تعديل يونيو 12, 2013 بواسطه محمد ابو البـراء
عبدالله باقشير قام بنشر يونيو 12, 2013 قام بنشر يونيو 12, 2013 السلام عليكم Option Explicit Sub kh_mKRR() Dim c As Integer Dim Last As Long, R As Long, LR As Long ''''''''''''''''''''''''''''' Last = ورقة1.Cells(Rows.Count, "A").End(xlUp).Row ''''''''''''''''''''''''''''' Range("A2").Resize(Cells(Rows.Count, "A").End(xlUp).Row).EntireRow.Delete ''''''''''''''''''''''''''''' Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ''''''''''''''''''''''''''''' With ورقة1 For R = 2 To Last If WorksheetFunction.CountIf(.Range("C2:C" & Last), CStr(.Cells(R, "c"))) > 1 Then LR = Cells(Rows.Count, "A").End(xlUp).Row + 1 .Cells(R, "A").Resize(1, 7).Copy Cells(LR, "A") End If Next End With ''''''''''''''''''''''''''''' Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic ''''''''''''''''''''''''''''' End Sub ترحيل الارقام المكررة.rar 2
رجب جاويش قام بنشر يونيو 12, 2013 قام بنشر يونيو 12, 2013 أستاذى الحبيب / عبد الله باقشير تسلم ايديك دائما أكوادك لها طابع خاص
عبدالله باقشير قام بنشر يونيو 12, 2013 قام بنشر يونيو 12, 2013 أستاذى الحبيب / عبد الله باقشير تسلم ايديك دائما أكوادك لها طابع خاص اكرمك الله اخي الحبيب رجب جاويش تقبل تحياتي وشكري
محمد ابو البـراء قام بنشر يونيو 12, 2013 الكاتب قام بنشر يونيو 12, 2013 السلام عليكم ورحمة الله وبركاته كم سعادتي بين استاذين جليلين من اساتذة الاكسيل استاذ الاساتذة / استاذ عبد الله باقشير واستاذي الحبيب / استاذ رجب جاويش فبارك الله فيكما وجعل الله اعمالكم في ميزان حسناتكم اللهم امين وجزاكم الله خيراً علامة الاكسيل استاذ عبدالله على هذا الكود الرائع والمميز بجد لا تعليق فمثلي لا يعلق على استاذ الاساتذة وعلامة الاكسيل. واخيراً استغل انني بين استاذين واسال كيف اعدل على هذا الكود لاغير من التنفيذ من عمود الى اخر بمعني ان التنفيذ هنا على العمود c _الرقم القومي _ فماذ لو اردت ان اجعل هذا الكود يتفاعل في مكان اخر مع عمود اخر وليكن لو اردت ان اخرج المكرر في الاسماء _ عمود b _ او اي عمود كــg او h او اي عمود ثانياً : كيف اعدل على الكودليقوم بترحيل نطاق اوسع للصف بدلا من هنا مثلا يرحل من a: g اريد ان اجعله اكبر وليكن مثلا a: t او غيره . وجزاكم الله خيرا واعذروني وانا اعلم انكم في غاية العون ومد اليد لمساعدة امثالى ممن لا يفقهون شى في مجال الاكسيل
عبدالله باقشير قام بنشر يونيو 13, 2013 قام بنشر يونيو 13, 2013 فماذ لو اردت ان اجعل هذا الكود يتفاعل في مكان اخر مع عمود اخر وليكن لو اردت ان اخرج المكرر في الاسماء _ عمود b _ او اي عمود كــg او h او اي عمود غير في هذا السطر العمود الذي تريد If WorksheetFunction.CountIf(.Range("C2:C" & Last), CStr(.Cells(R, "c"))) > 1 Then كيف اعدل على الكودليقوم بترحيل نطاق اوسع للصف بدلا من هنا مثلا يرحل من a: g اريد ان اجعله اكبر وليكن مثلا a: t او غيره . .Cells(R, "A").Resize(1, 7) من العمود a الى g سبعة اعمدة غير العدد سبعة الى اي عدد تريد اذا غيرت الى 20 سيكون من العمود a الى t تحياتي 3
محمد ابو البـراء قام بنشر يونيو 13, 2013 الكاتب قام بنشر يونيو 13, 2013 جزاكم الله خيراً وجعلك عونا لخدمة اخوانك وجعل الله عملك في ميزانك اللهم امين
محمد الورفلي1 قام بنشر أغسطس 20, 2014 قام بنشر أغسطس 20, 2014 السلام عليكم Option Explicit Sub kh_mKRR() Dim c As Integer Dim Last As Long, R As Long, LR As Long ''''''''''''''''''''''''''''' Last = ورقة1.Cells(Rows.Count, "A").End(xlUp).Row ''''''''''''''''''''''''''''' Range("A2").Resize(Cells(Rows.Count, "A").End(xlUp).Row).EntireRow.Delete ''''''''''''''''''''''''''''' Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ''''''''''''''''''''''''''''' With ورقة1 For R = 2 To Last If WorksheetFunction.CountIf(.Range("C2:C" & Last), CStr(.Cells(R, "c"))) > 1 Then LR = Cells(Rows.Count, "A").End(xlUp).Row + 1 .Cells(R, "A").Resize(1, 7).Copy Cells(LR, "A") End If Next End With ''''''''''''''''''''''''''''' Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic ''''''''''''''''''''''''''''' End Sub ممتاز جداً جداً ان شاء الله في ميزان حسناتك
إبراهيم ابوليله قام بنشر أغسطس 21, 2014 قام بنشر أغسطس 21, 2014 السلام عليكم ورحمة الله وبركاته اخى واستاذنا عبد الله باقشير جزاء الله خيرا على اعمالك العظيمه نسأل الله ان يزيدك من فضله وعلمه تقبل تحياتى
صلاح الصغير قام بنشر أغسطس 21, 2014 قام بنشر أغسطس 21, 2014 (معدل) ا / عبد الله عمل رائع و لتكون النتيجة اوضح و اسهل اعتقد من الافضل ان يكون الصفين المكررين تحت بعض لسهولة المقارنة تم تعديل أغسطس 21, 2014 بواسطه صلاح الصغير
محمد الورفلي1 قام بنشر أغسطس 24, 2014 قام بنشر أغسطس 24, 2014 (معدل) السلام عليكم الاخ صلاح على حسب فهمى اضفت كود ابجدة وتستطيع تغير الابجدة بحسب ما ترى مناسب من الاعمدة ترحيل 2.rar تم تعديل أغسطس 24, 2014 بواسطه محمد الخازمي
صلاح الصغير قام بنشر أغسطس 27, 2014 قام بنشر أغسطس 27, 2014 ا / محمد حضرتك جبت المكرر بناء على الاسماء المطلوب اظهار اصحاب الارقام القومية المكررة حسب التكرار بالرقم القومى تحت بعض و هم ملونون باللون البرتقالى
محمد الورفلي1 قام بنشر أغسطس 27, 2014 قام بنشر أغسطس 27, 2014 السلام عليكم جرب هذا المرفق لقد وجدت كود من فتر واستخدمته ممكن يكون ما تريد ترحيل بقائمة منسدلة.rar 2
أبوســـارة1973 قام بنشر أغسطس 28, 2014 قام بنشر أغسطس 28, 2014 جميل جدا هذا الكود ، يمكن أن نستفيد منه في تطبيقات كثيرة ، منها قوائم الصفوف 1
محمد الورفلي1 قام بنشر أغسطس 28, 2014 قام بنشر أغسطس 28, 2014 رائع يا ا / محمد ربنا يخليك شكراً استاذ هيثم كمال
محمد الورفلي1 قام بنشر أغسطس 28, 2014 قام بنشر أغسطس 28, 2014 جميل جدا هذا الكود ، يمكن أن نستفيد منه في تطبيقات كثيرة ، منها قوائم الصفوف هذا الصرح فرصة كبيرة لنتعلم منه وفي هذا المنتدي وجدت عجب العجاب من الاكواد فبارك الله في الاساتذة
صلاح الصغير قام بنشر أغسطس 28, 2014 قام بنشر أغسطس 28, 2014 رائع يا ا / محمد ربنا يخليك اكثر من رائع و مفيد جدا
محمد الورفلي1 قام بنشر أغسطس 28, 2014 قام بنشر أغسطس 28, 2014 رائع يا ا / محمد ربنا يخليك اكثر من رائع و مفيد جدا الشكر لله اولاً وبعد ذالك للاخوه الاساتذة بارك الله فيهم تعلمنا منهم ومازلنا نتعلم مهاراتهم لهم منى كل التقدير والاحترام
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.