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

[Yasser Fathi Albanna]

أنا أسف أسف أسف جدا

أستأذنك أنظر للمشاركة رقم 6 التى تفضلت بها حضرتك

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

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

كما فى المثال الأتى موضح النتائج بس تعديل الكود الذى تفضل بتعديله الأستاذ أبو عيد لم يقم بنقل قيمة المبيعات أما الأسماء بالكامل كما ذكرت فى المشاركة رقم 20

أسف جدا للإطالة وتعب حضرتك معايا

Customers New Only End.rar

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

أخي الكريم ياسر

أشعر أني تهت بالموضوع الآن

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

 

[Yasser Fathi Albanna]

المطلوب هو نقل قيمة المبيعات التى أمام إسم العميل فى كل شهر بدون أى إضافات أو تغييرات كما هي

ولكن المطلوب نقل العملاء الجدد فقط المتجددين شهريا بقيمة المبيعات التى أمام كل إسم دون أن يكون مكررين فى الشهور السابقة  مع تثبيت نقل شهر يناير بالكامل كما هو كما موضح بالمثال الأتى

 

Customers New Only End.rar

أسف جدا يا أستاذ ياسر لتعطيل حضرتك بس الموضوع هام بالنسبة لى سوف ينجز معى أشياء كثيرة

[Yasser Fathi Albanna]

أخى الحبيب / ياسر

هل المطلوب وضح أم لا

 

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

أخي الغالي ياسر فتحي

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

Sub PullUniques()
    Dim clnMyUniqueList As New Collection
    Dim lngMyCol As Long
    Dim lngMyRow As Long

    Application.ScreenUpdating = False
        For lngMyCol = 2 To 25 Step 2
            For lngMyRow = 5 To Cells(Rows.Count, lngMyCol).End(xlUp).Row
                On Error Resume Next
                clnMyUniqueList.Add Item:=Cells(lngMyRow, lngMyCol).Value, Key:=CStr(Cells(lngMyRow, lngMyCol).Value)
                If Err.Number = 0 Then
                    Cells(Rows.Count, lngMyCol + 25).End(xlUp).Offset(1, 0).Value = Cells(lngMyRow, lngMyCol).Value
                    Cells(Rows.Count, lngMyCol + 26).End(xlUp).Offset(1, 0).Value = Cells(lngMyRow, lngMyCol + 1).Value
                End If
                On Error GoTo 0
            Next lngMyRow
        Next lngMyCol
    
        Set clnMyUniqueList = Nothing
    Application.ScreenUpdating = True
End Sub

 

Customers New Only End.rar

[Yasser Fathi Albanna]

أستاذى القدير والغالى / ياسر خليل

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

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

ألف ألف مليون شكر وأسف إنى تعبت حضرتك معايا

 

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

الحمد لله أن تم المطلوب على خير أخي الغالي ياسر

ويرجى عند وجود طلب جديد يختلف عن الأول أن تقوم بطرح موضوع جديد ، فلن يكون الأمر مرهق على الإطلاق

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

[Yasser Fathi Albanna]

الحمد لله أن تم المطلوب على خير أخي الغالي ياسر

ويرجى عند وجود طلب جديد يختلف عن الأول أن تقوم بطرح موضوع جديد ، فلن يكون الأمر مرهق على الإطلاق

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

حاضر سوف أقوم بطرح موضع مستقل عند إضافة أى تغيرات أخى الحبيب ياسر

أدام عليك الله الصحة والعافية