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

[ابو حمادة]

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

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

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

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

محتاج كود لتنقية البيانات المكرره في النطاق من (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

 

[ابو حمادة]

  في 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  

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

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

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

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

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

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

 

[احمدزمان]

  في 4‏/4‏/2018 at 20:34, ali mohamed ali said:

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

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

Expand  

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

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

  في 4‏/4‏/2018 at 21:27, ابو حمادة said:

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

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

Expand  

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

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

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

 

[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

 

[ابو حمادة]

  في 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

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

 

 

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

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

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

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

 

[melaad]

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

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

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

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

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

  في 22‏/4‏/2018 at 13:46, melaad said:

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

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

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

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

Expand  

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