اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

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

كل عام وانتم بخير

اخوتي الشيت المرفق به جدول مكون من رقم العداد وتسلسل العداد ويوجد بالشيت ادخالات متشابهة اريد معرفة الارقام المتشابهة لحذفها من الشيت وعدم تكرارها بنفس الجدول

edit.xlsx

قام بنشر

وعليكم السلام- الأمر بسيط وسهل ..عليك فقط تحديد عمود البيانات التى تريد حذف المكرر منها ثم الذهاب الى قائمة Data ثم الضغط على Remove Duplicates وذلك كما بالصورة

 

 

1.png

  • تمت الإجابة
قام بنشر

يا اخي 

لست بحاجة الى اكثر من 6000 صف لمعاينة عمل ماكرو

الماكرو الذي ينفذ على صف واحد يمكن ان يعمل على الوف الصفوف

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

الكود

Option Explicit

Sub SansDoublons_By_FirstAcurance()
If ActiveSheet.Name <> "Sheet1" Then Exit Sub

Dim d As Object
Dim Lr_c#, i#, k#, a(), b()
Dim x
x = [G4].CurrentRegion.Rows.Count
If x > 6 Then _
[G4].CurrentRegion.Offset(6).Resize(x - 6).Clear
Lr_c = Cells(Rows.Count, "c").End(3).Row
If Lr_c < 10 Then Exit Sub
  Set d = CreateObject("Scripting.Dictionary")
 a = Range("C10:D" & Lr_c)
  ReDim b(1 To UBound(a, 1))
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> vbNullString Then
     For k = 1 To UBound(a, 2): b(k) = a(i, k): Next
      d.Item(a(i, 1)) = b
    End If
  Next i
  With [G10].Resize(d.Count, UBound(a, 2))
  .Value = Application.Transpose(Application.Transpose(d.items))
  .Borders.LineStyle = 1
  .InsertIndent 1
  End With

End Sub

الملف مرفق

Without_Duplicate.xlsm

  • Like 1

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information