كود لحذف التكرار

[seddiki_adz]

طلب مساعدة من الخبراء الاكارم

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

Classeur32.xlsx

[Ali Mohamed Ali]

تفضل الأمر سهل وبسيط يمكنك مشاهدة هذا الفيديو

https://www.youtube.com/watch?v=JOGUVtuJAQ4

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

قم بادراج ورقة وتسميهتا Salim  (أو قم بتسمية اي ورقة فارغة  Salim)

ثم نفذ هذا الكود (و ترى النتيجة في شيت Salim)

Option Explicit

Sub REMOVE_DUPL()


  Sheets("Salim").Range("a1").CurrentRegion.Clear
  Sheets("Feuil1").Range("a1").CurrentRegion.Copy _
  Sheets("Salim").Range("a1")
  Sheets("Salim").Range("a3").CurrentRegion.RemoveDuplicates _
  Columns:=Array(2, 6, 7, 8, 9, 10 _
        , 11, 12, 13, 14, 15), Header:=1
   Application.CutCopyMode = False
End Sub

الملف مرفق

Classeur32_A.xlsm

[seddiki_adz]

جزاكم الله خير ورفع مقداركم 

احي سليم عملت كما قلت تفضل اين الاشكالية؟

Classeur092019.xlsx

تم تعديل سبتمبر 2, 2019 بواسطه seddiki_adz

[seddiki_adz]

تحية طيبة

ارجو المساعدة تحديد الخلل في التخلص من التكرار  ولكم فائق الشكر والاحترام

archive.zip

تم تعديل سبتمبر 4, 2019 بواسطه seddiki_adz

[seddiki_adz]

سلام الله عليكم

الى الخبراء الاكارم 

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

فمن يمد لنا يد المساعدة؟

archive.zip

[seddiki_adz]

ارجو شرح الكود لاستطيع معالجة الامر

الكود ليس به خطأ في الصفة salim به كود لحذف التكرار  والصفحة 2 للترحيل من الصفحة 1 عندما أنفذ  كود سليم لا ينفذ لا أعرف أين الخلل الذي ارتكبت والملف  موجود الملف المضغوط

archive.zip

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

اخي الفاضل

 

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

ملفك الحالي الصفحة  الرئيسية اضفت انت  اليها معادلات صفيف وغيرها

 الكود قام بنسخ البيانات من الصفحة الرئيسية بالمعادلات ورحلهاالى صفحةsalim  

طبعا المعادلات مرتبطة بخلايا منها  اسم المؤسسة وغيرها

لذلك لن تجد اي بيانات  في صفحة سليم

هذا تفسيري  والله اعلم

ولكن محاولة منى حتى يقوم الاستاذ سليم بالتعديل المناسب

Classeur3.xls

 

[seddiki_adz]

 

 

بورك فيك اخي عبدالله الصاري وجزاك الله خيرا عمل ممتاز

والله الشكر غير كافي لما تقدمه من عمل ممتاز

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

الاقتباس ليس له علاقة بالموضوع

وفيك بارك الله

تحياتي

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

لجعل الكود اسرع بحوالي 50 مرة

1-عملية Select  تأخذ وقتاً طويلاً لذلك في اي كود يجب ان نتغاضى عنها قدر الامكان

2-استعمال  With و End With مهمة جداً لتسريع اي كود

3-اعادة الحساب مع كل خلية تأخذ وقتاَ ايضاُ لذلك تم استعمال Calculation =Manual ليوقف البرنامج

    جميع العمليات الحسابية  ريثما ينتهي الكود من عمله

4- اعادة Calculation  الى Automatic بعد انتهاء الكود

 

Option Explicit

Sub REMOVE_DUPL_NEW()
    Dim S As Worksheet:     Set S = Sheets("salim")
    Dim F2 As Worksheet:    Set F2 = Sheets("Feuil2")
    
    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    End With
 
    With S
        .Range("A1") = F2.Range("a1")
        .Range("a3").CurrentRegion.Clear
         F2.Range("a3").CurrentRegion.Copy _
         S.Range("a3")
        .Range("a3").CurrentRegion.Value = _
        .Range("a3").CurrentRegion.Value
        .Range("a3").CurrentRegion.RemoveDuplicates _
         Columns:=Array(2, 6, 7, 8, 9, 10 _
              , 11, 12, 13, 14, 15), Header:=1
  End With
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    Set S = Nothing: Set F2 = Nothing
End Sub

الملف مرفق

Classeur3_salim.xlsm

[seddiki_adz]

حفظك الله اخي سليم وكل الشكر والتقدير جعل الله أعمالك في ميزان حسناتك