ابو حمادة قام بنشر أبريل 4, 2018 قام بنشر أبريل 4, 2018 السلام عليكم ورحمة الله تعالى وبركاته اساتذتى الكرام رجاء المساعده ملف للتطبيق : بيانات مكررة.rarFetching info... محتاج كود لتنقية البيانات المكرره في النطاق من (A6:DZ) معيار التكرار هو الرقم القومي فى العمود (C) في حالة تكرارالرقم القومي اكثر من مره يتم مسح بيانات الصف باكمله للرقم القومى المكرر وجزاكم الله كل خير وزادكم علما نافعا تنفعون به الناس وتنفعون به انفسكم
احمدزمان قام بنشر أبريل 4, 2018 قام بنشر أبريل 4, 2018 و عليكم السلام و رحمة الله وبركاته جرب هذا الكود Sub Mokarar() Dim Q1, FR, TR, TC For FR = 5 To 9999 Q1 = Cells(FR, 3) If Q1 = "" Then GoTo 7 For TR = FR + 1 To 9999 If Cells(TR, 3) = Q1 Then For TC = 1 To 33 Cells(TR, TC).Clear Next End If Next 7 Next End Sub ان شاء الله يكون به ماتريد 1 1
Ali Mohamed Ali قام بنشر أبريل 4, 2018 قام بنشر أبريل 4, 2018 تسلم ايديك استاذ أحمد كود حقا رائع ونفذ المطلوب بكل دقة بارك الله فيك وجعله فى ميزان حسناتك 1
سليم حاصبيا قام بنشر أبريل 4, 2018 قام بنشر أبريل 4, 2018 جرب هذا الماكرو Option Explicit 'Macro to delete duplicates in Columm Sub del_row() Dim i%, k% Dim x% k = Range("a6").CurrentRegion.Rows.Count For i = 6 To k If i > k Then Exit For x = Application.CountIf(Range("c6:c" & i), Cells(i, 3)) If x > 1 Then Cells(i, 1).EntireRow.Delete: i = i - 1: k = k - 1 Next End Sub 1 1
ابو حمادة قام بنشر أبريل 4, 2018 الكاتب قام بنشر أبريل 4, 2018 في 4/4/2018 at 20:04, احمدزمان said: و عليكم السلام و رحمة الله وبركاته جرب هذا الكود Sub Mokarar() Dim Q1, FR, TR, TC For FR = 5 To 9999 Q1 = Cells(FR, 3) If Q1 = "" Then GoTo 7 For TR = FR + 1 To 9999 If Cells(TR, 3) = Q1 Then For TC = 1 To 33 Cells(TR, TC).Clear Next End If Next 7 Next End Sub ان شاء الله يكون به ماتريد Expand الف الف شكر استاذي الغالى الكود تمام بس ليا طلب لو امكن يعمل الكود لاخر صف به بيانات فى العمود (C) واضافة اسم ورقة العمل على الكود في 4/4/2018 at 20:45, سليم حاصبيا said: جرب هذا الماكرو Option Explicit 'Macro to delete duplicates in Columm Sub del_row() Dim i%, k% Dim x% k = Range("a6").CurrentRegion.Rows.Count For i = 6 To k If i > k Then Exit For x = Application.CountIf(Range("c6:c" & i), Cells(i, 3)) If x > 1 Then Cells(i, 1).EntireRow.Delete: i = i - 1: k = k - 1 Next End Sub Expand شكرا استاذي على اهتمامك الكود يمسح بعض الارقام المكرره ويترك الباقي
سليم حاصبيا قام بنشر أبريل 5, 2018 قام بنشر أبريل 5, 2018 هذا لانه هناك خلايا فارغة بالعامود لتلافي ذلك استبدله بهذا الكود Option Explicit Sub del_row() Dim i%, k% Dim x% k = Cells(Rows.Count, 3).End(3).Row If k < 6 Then k = 6 For i = 6 To k If i > k Then Exit For x = Application.CountIf(Range("c6:c" & i), Cells(i, 3)) If x > 1 Then Cells(i, 1).EntireRow.Delete: i = i - 1: k = k - 1 Next End Sub 1 1
احمدزمان قام بنشر أبريل 5, 2018 قام بنشر أبريل 5, 2018 في 4/4/2018 at 20:34, ali mohamed ali said: تسلم ايديك استاذ أحمد كود حقا رائع ونفذ المطلوب بكل دقة بارك الله فيك وجعله فى ميزان حسناتك Expand جزاك الله خيرا و احسن الله اليك وهذا لا يساوي شيء امام ابداعاتكم في المنتدى في 4/4/2018 at 21:27, ابو حمادة said: الكود تمام بس ليا طلب لو امكن يعمل الكود لاخر صف به بيانات فى العمود (C) واضافة اسم ورقة العمل على الكود Expand ان شاء الله لا مشكلة الآن انا في العمل مساء ان شاء الله
Ali Mohamed Ali قام بنشر أبريل 5, 2018 قام بنشر أبريل 5, 2018 كو حقا رائع أستاذ سليم-ونفذ المطلوب بدقة متناهية جعله الله فى ميزان حسناتك وبارك الله فيك وجزاك خيرا كثيرا 1
احمدزمان قام بنشر أبريل 5, 2018 قام بنشر أبريل 5, 2018 السلام عليكم تمت الإضافة بالاستعانة بكود الأستاذ سليم جزاه الله خيرا Sub Mokarar() Dim Q1, FR, TR, TC, ER With Sheets(ActiveSheet.Name) ER = Application.CountA(.Range("C:C")) + 9 For FR = 5 To ER Q1 = .Cells(FR, 3) If Q1 = "" Then GoTo 7 For TR = FR + 1 To 9999 If .Cells(TR, 3) = Q1 Then For TC = 1 To 33 .Cells(TR, TC).Clear Next End If Next 7 Next End With End Sub 1
ابو حمادة قام بنشر أبريل 5, 2018 الكاتب قام بنشر أبريل 5, 2018 في 5/4/2018 at 03:21, سليم حاصبيا said: هذا لانه هناك خلايا فارغة بالعامود لتلافي ذلك استبدله بهذا الكود Option Explicit Sub del_row() Dim i%, k% Dim x% k = Cells(Rows.Count, 3).End(3).Row If k < 6 Then k = 6 For i = 6 To k If i > k Then Exit For x = Application.CountIf(Range("c6:c" & i), Cells(i, 3)) If x > 1 Then Cells(i, 1).EntireRow.Delete: i = i - 1: k = k - 1 Next End Sub Expand شكرا لاهتماك استاذي الكبير حولت استخدم ااكود بيدي خطأ فى سطر k = Cells(Rows.Count, 3).End(3).Row واتمنى لو يتم تحديد ورقة العمل الذي يعمل عليها الكود
سليم حاصبيا قام بنشر أبريل 5, 2018 قام بنشر أبريل 5, 2018 اكتب هذا السطر في الكود مباشرة بعد كلمة Sub If ActiveSheet.Name<>"XXXX" then Exit Sub اكتب اسم الشيت مكان XXXX 2
melaad قام بنشر أبريل 22, 2018 قام بنشر أبريل 22, 2018 هل ممكن حد من السادة الافاضل يعمل الكود على ملف اكسيل لان خبرتى ضعيفة ومحتاج الكود ده عندى ملف فيه خانات زى الاسم ورقم التليفون وبيان لكن رقم التليفون فيه تكرار ومحتاج امسح السطر كله ويسيبلى سطر واحد من الاسطر التى تم تكرارها
سليم حاصبيا قام بنشر أبريل 22, 2018 قام بنشر أبريل 22, 2018 في 22/4/2018 at 13:46, melaad said: هل ممكن حد من السادة الافاضل يعمل الكود على ملف اكسيل لان خبرتى ضعيفة ومحتاج الكود ده عندى ملف فيه خانات زى الاسم ورقم التليفون وبيان لكن رقم التليفون فيه تكرار ومحتاج امسح السطر كله ويسيبلى سطر واحد من الاسطر التى تم تكرارها Expand ارفع نموذجاً عما تريد
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.