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

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

قام بنشر

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

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

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

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information