ابو حمادة قام بنشر أبريل 4, 2018 مشاركة قام بنشر أبريل 4, 2018 السلام عليكم ورحمة الله تعالى وبركاته اساتذتى الكرام رجاء المساعده ملف للتطبيق : بيانات مكررة.rar محتاج كود لتنقية البيانات المكرره في النطاق من (A6:DZ) معيار التكرار هو الرقم القومي فى العمود (C) في حالة تكرارالرقم القومي اكثر من مره يتم مسح بيانات الصف باكمله للرقم القومى المكرر وجزاكم الله كل خير وزادكم علما نافعا تنفعون به الناس وتنفعون به انفسكم رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر أبريل 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 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر أبريل 4, 2018 مشاركة قام بنشر أبريل 4, 2018 تسلم ايديك استاذ أحمد كود حقا رائع ونفذ المطلوب بكل دقة بارك الله فيك وجعله فى ميزان حسناتك 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 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 رابط هذا التعليق شارك More sharing options...
ابو حمادة قام بنشر أبريل 4, 2018 الكاتب مشاركة قام بنشر أبريل 4, 2018 منذ ساعه, احمدزمان 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 ان شاء الله يكون به ماتريد الف الف شكر استاذي الغالى الكود تمام بس ليا طلب لو امكن يعمل الكود لاخر صف به بيانات فى العمود (C) واضافة اسم ورقة العمل على الكود 43 دقائق مضت, سليم حاصبيا 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 شكرا استاذي على اهتمامك الكود يمسح بعض الارقام المكرره ويترك الباقي رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 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 رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر أبريل 5, 2018 مشاركة قام بنشر أبريل 5, 2018 10 ساعات مضت, ali mohamed ali said: تسلم ايديك استاذ أحمد كود حقا رائع ونفذ المطلوب بكل دقة بارك الله فيك وجعله فى ميزان حسناتك جزاك الله خيرا و احسن الله اليك وهذا لا يساوي شيء امام ابداعاتكم في المنتدى 10 ساعات مضت, ابو حمادة said: الكود تمام بس ليا طلب لو امكن يعمل الكود لاخر صف به بيانات فى العمود (C) واضافة اسم ورقة العمل على الكود ان شاء الله لا مشكلة الآن انا في العمل مساء ان شاء الله رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر أبريل 5, 2018 مشاركة قام بنشر أبريل 5, 2018 كو حقا رائع أستاذ سليم-ونفذ المطلوب بدقة متناهية جعله الله فى ميزان حسناتك وبارك الله فيك وجزاك خيرا كثيرا 1 رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر أبريل 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 رابط هذا التعليق شارك More sharing options...
ابو حمادة قام بنشر أبريل 5, 2018 الكاتب مشاركة قام بنشر أبريل 5, 2018 12 ساعات مضت, سليم حاصبيا 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 شكرا لاهتماك استاذي الكبير حولت استخدم ااكود بيدي خطأ فى سطر k = Cells(Rows.Count, 3).End(3).Row واتمنى لو يتم تحديد ورقة العمل الذي يعمل عليها الكود رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 5, 2018 مشاركة قام بنشر أبريل 5, 2018 اكتب هذا السطر في الكود مباشرة بعد كلمة Sub If ActiveSheet.Name<>"XXXX" then Exit Sub اكتب اسم الشيت مكان XXXX 2 رابط هذا التعليق شارك More sharing options...
melaad قام بنشر أبريل 22, 2018 مشاركة قام بنشر أبريل 22, 2018 هل ممكن حد من السادة الافاضل يعمل الكود على ملف اكسيل لان خبرتى ضعيفة ومحتاج الكود ده عندى ملف فيه خانات زى الاسم ورقم التليفون وبيان لكن رقم التليفون فيه تكرار ومحتاج امسح السطر كله ويسيبلى سطر واحد من الاسطر التى تم تكرارها رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 22, 2018 مشاركة قام بنشر أبريل 22, 2018 55 دقائق مضت, melaad said: هل ممكن حد من السادة الافاضل يعمل الكود على ملف اكسيل لان خبرتى ضعيفة ومحتاج الكود ده عندى ملف فيه خانات زى الاسم ورقم التليفون وبيان لكن رقم التليفون فيه تكرار ومحتاج امسح السطر كله ويسيبلى سطر واحد من الاسطر التى تم تكرارها ارفع نموذجاً عما تريد رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.