جلب البيانات بدون تكرار

[kkfhvvv]

السلام عليكم

ممكن الاطلاع على الملف المرفق 0 وتعديل على الكود

وذلك ان الكود يعمل جلب البيانات بدون تكرار

ولكن يوجد تكرارات

 

جلب التفاصيل.xlsm

[محمد هشام.]

تفضل اخي  اليك حل اخر ربما هدا ما تقصده 

Sub OterDoublons()
Dim der As Long, j As Long, Lastrow As Long

Application.ScreenUpdating = False
    
Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("البيانات")
Dim desWS As Worksheet: Set desWS = ThisWorkbook.Sheets("ارقام")

Lastrow = WS.Cells(WS.Rows.Count, "O").End(xlUp).Row
   desWS.Range("A2:C" & Rows.Count).ClearContents
   WS.Range("O2:Q" & Lastrow).Copy _
    Destination:=desWS.Range("A2")
            
      With desWS
      If .FilterMode Then .ShowAllData
      For j = 1 To Range("C2").Column
         der = .Cells(.Rows.Count, j).End(xlUp).Row
         If der >= 2 Then .Cells(1, j).Resize(der).RemoveDuplicates Columns:=1, Header:=xlYes
      Next j
   End With
   Application.ScreenUpdating = True

End Sub

 

جلب التفاصيل V2.xlsm

[kkfhvvv]

السلام عليكم - 

لا استاذ

مو هذا المطلوب

الكود الاول شغال ولكن في فقرة او فقرتين بجلب المكرر حسب الشروط الثلاثة المبينة بالملف المرفق

كان فقط - توجد بعض التكرارات برقم المطالبة

ارفقت ملف يوضح المطلوب

 

جلب التفاصيل V2-مثال.xlsm

[احمد عبدالحليم]

تفضل اخى 

جرب واعلمنى بالنتيجة 

تم اضافة اعادة ترتيب البيانات تصاعديا حسب التاريخ 

جرب الكود والملف 

 

 

تعديل جلب التفاصيل.xlsm

[kkfhvvv]

الله يرضى عليك

تسلم  - الكود ا- ممتاز

تمام

جربت الكود على بياناتي

100 %

جزيت خيرا

 

 

 

 

 

 

تم تعديل فبراير 27 بواسطه kkfhvvv

[محمد هشام.]

6 ساعات مضت, kkfhvvv said:

مو هذا المطلوب

تمام اخي لقد فهمت طلبك بشكل خاطئ اظن ان حل الاستاد @احمد عبدالحليم  سيوفي بالغرض 

بالتوفيق