مسح البيانات المكرره

[ابو حمادة]

السلام عليكم ورحمة الله تعالى وبركاته

اساتذتى الكرام

رجاء المساعده

ملف للتطبيق : بيانات مكررة.rar

محتاج كود لتنقية البيانات المكرره في النطاق من (A6:DZ) معيار التكرار هو الرقم القومي فى العمود (C) في حالة تكرارالرقم القومي اكثر من مره يتم  مسح بيانات الصف باكمله  للرقم القومى المكرر

وجزاكم الله كل خير وزادكم علما نافعا تنفعون به الناس وتنفعون به انفسكم

[احمدزمان]

و عليكم السلام و رحمة الله وبركاته

جرب هذا الكود

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

ان شاء الله يكون به ماتريد

[Ali Mohamed Ali]

تسلم ايديك استاذ أحمد كود حقا رائع ونفذ المطلوب بكل دقة

بارك الله فيك وجعله فى ميزان حسناتك

[سليم حاصبيا]

جرب هذا الماكرو

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

 

[ابو حمادة]

منذ ساعه, احمدزمان 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

 

شكرا استاذي على اهتمامك

الكود يمسح بعض الارقام المكرره ويترك الباقي 

[سليم حاصبيا]

هذا لانه هناك خلايا فارغة بالعامود

لتلافي ذلك استبدله بهذا الكود

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

 

[احمدزمان]

10 ساعات مضت, ali mohamed ali said:

تسلم ايديك استاذ أحمد كود حقا رائع ونفذ المطلوب بكل دقة

بارك الله فيك وجعله فى ميزان حسناتك

جزاك الله خيرا و احسن الله اليك

وهذا لا يساوي شيء امام ابداعاتكم في المنتدى

10 ساعات مضت, ابو حمادة said:

الكود تمام بس ليا طلب لو امكن يعمل الكود لاخر صف به بيانات فى العمود (C)

واضافة اسم ورقة العمل على الكود

ان شاء الله لا مشكلة

الآن انا في العمل

مساء ان شاء الله

 

[Ali Mohamed Ali]

كو حقا رائع أستاذ سليم-ونفذ المطلوب بدقة متناهية جعله الله فى ميزان حسناتك وبارك الله فيك وجزاك خيرا كثيرا

[احمدزمان]

السلام عليكم

تمت الإضافة بالاستعانة بكود الأستاذ سليم جزاه الله خيرا

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

 

[ابو حمادة]

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

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

 

 

[سليم حاصبيا]

اكتب هذا السطر في الكود مباشرة بعد كلمة Sub

If ActiveSheet.Name<>"XXXX" then Exit Sub

 اكتب اسم الشيت  مكان   XXXX    

 

[melaad]

هل ممكن حد من السادة الافاضل يعمل الكود على ملف اكسيل

لان خبرتى ضعيفة ومحتاج الكود ده

عندى ملف فيه خانات زى الاسم ورقم التليفون وبيان

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

[سليم حاصبيا]

55 دقائق مضت, melaad said:

هل ممكن حد من السادة الافاضل يعمل الكود على ملف اكسيل

لان خبرتى ضعيفة ومحتاج الكود ده

عندى ملف فيه خانات زى الاسم ورقم التليفون وبيان

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

ارفع نموذجاً عما تريد