مقایسه وحذف داده های تکراری

[sohrabahmadi]

با سلام به دوستان و اساتید گرامی . برای مقایسه و حذف دادهای شیت 2 که در شیت 1 هم هستند از این فرمول استفاده کردم:
Private Sub CommandButton1_Click()
Dim c As Range
Dim d As Range
For Each c In Sheet2.Range("a1:a500")
If c <> "" Then
For Each d In Sheet1.Range("a1:a50000")
If d.Value = c.Value And d.Offset(0, 1).Value = c.Offset(0, 1).Value Then
c = ""
c.Offset(0, 1).Value = ""
c.Offset(0, 2).Value = ""
End If
Next
End If
Next
End Sub
منتها با توجه به اینکه حجم داده ها بالاست عملکردش خیلی کند هستش .
اگه اساتید فرمول رو اصلاح یا راه حل بهتری معرفی کنن ممنون میشم.با تشکر

[امين اسماعيلي]

خوب اول اینکه اگه شما بتونی کاری کنی که آخرین سل همیشه معلوم باشه بهتر میشد. دوم اینکه screen update رو خاموش کنی.
کد زیر رو در اولین خط باشه:
Application.ScreenUpdating=False

ودر اخر کد هات هم دوبره روشن کنی :
اخرین خط
Application.ScreenUpdating=True

[sohrabahmadi]

با سلام و تشکر از استاد اسماعیلی عزیز .اینکارو کرده بودم ولی فرقی نکرده بود؟ راجع به انتخاب آخرین سل هم اگه راهنمایی بفرمایین ممنون میشم. اگه منظورتون Sheet2.Range("a50000").End(xlUp).Select هستش کجا باید استفاده کنم .البته فکر نکنم تو فرمول بالا بشه ازش استفاده کرد.بازم ممنون

[sohrabahmadi]

با سلام یه راه حل سریعتر پیدا کردم . گفتم بگم شاید به درد دوستان بخوره ان شاالله

Dim c As Range
For Each c In Sheet2.Range("A1:A500")
If Application.WorksheetFunction.CountIfs(Sheet1.Rang e("a1:a50000"), c, Sheet1.Range("b1:b50000"), c.Offset(0, 1)) = 1 Then
c = ""
c.Offset(0, 1) = ""
c.Offset(0, 2) = ""
End If
Next

[smartman]

من ترجیح میدم این کار را بدون VBA و یا حداکثر با ضبط یک ماکرو انجام بدم!
به این ترتیب:
1- یافتن موارد تکراری (موارد مشابه در دوشیت) با افزودن یک ستون با فرمول CountIfs در کاربرگ2
2- فیلتر کردن ستون فوق برای موارد غیر صفر
3- انتخاب سطرهای موارد فیلتر شده
4- انتخاب سطرهای آشکار: Home Tab → Find & Select → Go To Special... → Visible Cells Only
5- - + Ctrl
6- البته اگه نیاز به حذف کل رکورد نباشه، بعد از مرحله 4 کافیست Delete را بزنید
:trollface: