أرجو المساعدة فى فلترة شيت أكسل

[kuwaittel]

السلام عليكم أخوانى,

عندى شيت أكسيل csv يحتوى على أرقام هواتف فى حدود ال 40 ألف رقم فية حوالى 14 ألف رقم مكرر

المطلوب :

حذف الأرقام المكررة بالشكل الأتى

أذا تكرر رقمين يتم حذف الرقمين وليس رقم واحد

(على سبيل المثال) أنا عندى 14 ألف رقم مكررين فى الشيت

المطلوب هو حذف 28 ألف رقم وهم الأرقام المكررة وأصل هذة الأرقام ليتم الأبقاء على الأرقام الغير مكررة تماما ليتم العمل عليها

أتمنى أن حد يقدر يساعدنى فى أيجاد حل لأنى فعلا تعبت جدا فى أيجاد حل

[kuwaittel]

الا يوجد أحد يريد مساعدتى :(

[أبو حنــــين]

السلام عليكم

اخي هذا الكود يحذف الاسماء او الارقام المتشابهة ثم يمسح الفراغات للمحافظة على الترتيب

لكن يحذف الارقام المتشابهة مثلا في العمود A من 1 الى 1000 و هو في هذه الحالة يستغرق حوالى دقيقة

فان كان كما ذكرت حذف المتشابه لـ 40000 فربما يستغرق وقتا طويلا لكبر القائمة

و لا ادري ان كان هناك كود يستغرق وقت اقل

و الله اعلم

Private Sub CommandButton1_Click()

Dim m, R

For Each R In Range("A2:A1000")

For m = 1 To 1000

If R.Offset(m, 0).Value = Cells(m, 1).Value Then

R.Offset(m, 0).ClearContents

End If: Next

Next

LR = [A1000].End(xlUp).Row

For i = LR To 2 Step -1

If Cells(i, 1) = "" Then

Rows(i).Delete Shift:=xlUp

End If: Next

End Sub

[kuwaittel]

أخى الحبيب أنا أريد طريقة ليس فقط لحذف المتشابهات فحذف المتشاباهات من الخلايا سهلا عن طريق filter > delete duplicated

أنما أريد طريقة لحذف المتشابهات من الخلايا والأرقام المشابهة لها أيضا

يعنى لو على سبيل المثال عندى ملف أكسيل فية 1000 رقم منهم 200 متشابهين يتحذفوا ال 200 المتشابهين و ال 200 المشابهين لهم يعنى الرقم المشابه وأصلة ذى الأصل والصورة كدة

وتتبقى الأرقام التى لا يوجد لها متشابهات

أتمنى أن الموضوع يكون مفهوم وأرجو المساعدة

[عبدالله باقشير]

السلام عليكم

جرب هذا

Sub kh_Delete()

Dim Rng As Range, cel As Range, ArRng As Range

''''''''''''''''''''''''

Set Rng = Range("A2:A1000")

''''''''''''''''''''''''

For Each cel In Rng

    If IsEmpty(cel) Then GoTo 1

    If WorksheetFunction.CountIf(Rng, cel) > 1 Then

        If ArRng Is Nothing Then Set ArRng = cel Else Set ArRng = Union(ArRng, cel)

    End If

1:

Next

If Not ArRng Is Nothing Then ArRng.Delete

Set Rng = Nothing

Set ArRng = Nothing


End Sub

[أبو حنــــين]

جزاك الله خيرا اخي عبد الله

كود في منتهى الدقة

[kuwaittel]

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

جزاك الله ألف خير أخى

[عبدالله باقشير]

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

جزاك الله ألف خير أخى

المرفق 2003

حذف المكرر الاصل والمكرر.rar

[عبدالله باقشير]

جزاك الله خيرا اخي عبد الله

كود في منتهى الدقة

وجزاك خيرا

اخي ابوحنين

النشيط دوما

ماشاء الله لاقوة الا بالله

[kuwaittel]

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

جزاك الله ألف خير أخى

المرفق 2003

جزاك الله ألف ألف ألف خير اخى عبد الله

بجد أنا متشكر ليك جدا جدا جدا

لأنك وفرت عليا الكثير من الوقت والمجهود فقد كنت أقوم بعمل هذة الفلترة بشكل يدوى

تم تعديل أكتوبر 5, 2012 بواسطه kuwaittel

[mohameddiap]

مشكوووووووووووووووور

[أبو الزبير]

شكرا لك أ. عبدالله صحيح أن الموضوع قديم لكن وبجد استفدت منه وكنت أعمله يدويا والآن خلاص يمكنني الإعتماد على الملف المرفق بإذن الله

الله يوفقك لما يحبه ويرضاه

[اسلام سيد]

السلام عليكم

كود رووووعه

جزاكم الله خيرا جميعا

 

------------------------------------------

 

فقط لزياده الموضوع اثراءا هل ممكن جعل الكود يحذف المكرر ،  فقط ويترك الاصل ، ويمسح الفراغات .

[على حسن]

هل بالامكان التعديل على هذا الكود 

New Microsoft Excel Worksheet.rar

[ياسر خليل أبو البراء]

الأخ الفاضل علي حسن

من الأفضل دائماً عدم إرفاق طلب في مشاركة فرعية ويفضل طرح موضوع جديد

ويبدو أنك قد فعلت .. قم بالإطلاع على موضوعك لترى الإجابة على الرابط التالي

من هنا