كيفية فرز عملاء

[Yasser Fathi Albanna]

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

بعد التحية

الرجاء المساعدة فى الشيت المرفق حيث أننى أريد فرز عملاء متعاملين من جميع عملاء الفرع فى نفس الشيت

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

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

وشكرا لسعة صدركم

فرز عملاء.rar

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

السلام عليكم

جرب هذا الكود في موديل

Sub sFind()

Dim i As Long
Dim C

With Sheets("Sheet1")
.Range("D4:D850") = ""
MsgBox "هذه العملية تتطلب بعض الوقت", vbInformation, "ملاحظة"
Application.ScreenUpdating = False
For Each C In .Range("C4:C850")
For i = 4 To 850
If C = .Cells(i, 2) Then C.Offset(0, 1) = .Cells(i, 2)

Next
Next
Application.ScreenUpdating = True
MsgBox "تم الحضول على  " & Application.WorksheetFunction.CountIf(.Range("D4:D850"), "<>") & "  اسم", vbInformation, "النتيجة"
End With

End Sub

[Yasser Fathi Albanna]

أساذى ومعلمى الفاضل

أنا جربت الكود وإشتغل معايا

ولكن أنا عايز فى الخانة المطلوب فيها العملاء الغير المتعاملة يبقى ( عملاء الفرع - العملاء المتعاملة ) فقط

يعنى عايز عملاء الفرع بدون العملاء المتعاملة  فى الخانة المطلوب فيها العملاء الغير متعاملة

وشكرا جزيلا أستاذى الفاضل والأخ الكريم أبو حنين  لسعة صدرك

[عطاء الله]

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

بعد إذن حماد عمر هذا حل آخر بواسطة المعادلات والحيل رغم أنه حجمه كبير لكثرة المعادلات لكنه يأتي بنتائج صحيحة

* - الملف السابق الذي طرحته أنا عملت سابقا لكن ما عرفت وين وضعته سوف ابحث عنه وسوف ارفقه لك

 

ata21.rar

[Yasser Fathi Albanna]

ألف ألف شكر أخى الفاضل عطا الله على إهتمامك

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

وشكرا لأخى ومعلمى الفاضل أو حنين أيضا على مجهودة الرائع

ولو يوجد كود يفى بهذا الغرض يا ريت حتى يتم تطبيقة على 38 فرع وشكرا لكم جميعا

وشكرا لهذا المنتدى العظيم

[Yasser Fathi Albanna]

للرفع بعد إذن السادة الأعضاء

[Yasser Fathi Albanna]

هل يوجد كود يؤدى نفس الغرض فى المرفق الأتى

أو معادلة أيضا

بعد إذن السادة الأفاضل الموضوع هام للغاية

العملاء.rar

[Yasser Fathi Albanna]

الرجاء الرد بعد إذن الجميع فالموضوع هام جدا جدا

وشكرا لكم جميعا

[Yasser Fathi Albanna]

السادة الأفاضل أستاذتى الكرام

هل أنا أسئت فى حاجه لعدم الإجابه على طلبى

أم أنه لا يوجد إفاده للمرفق الأخير

الرجاء الإفاده بعد إذن الجميع  حيث أن الموضوع هام جدا جدا بالنسبة لى

وشكرا لسعة صدركم

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

رغم انني لم استوعب المطلوب كما ينبغي لكن جرب هذا الكود

Sub sFind()

Dim R As Long, x As Long, i As Long
    Application.ScreenUpdating = False
    With Sheets("Sheet1")
    
    R = .Cells(Rows.Count, "B").End(xlUp).Row
    x = 3
    For i = 4 To R
    If Application.WorksheetFunction.CountIf(.Range("B4:C" & R), .Cells(i, 3)) = 1 Then
    x = x + 1
    .Cells(x, "D") = .Cells(i, 2)
    
    End If
    Next
    End With
    Application.ScreenUpdating = True
    
End Sub

تم تعديل ديسمبر 17, 2013 بواسطه أبو حنين

[Yasser Fathi Albanna]

اخى الفاضل أستاذى ومعلمى الجليل / أبو حنين

الشيت المرفق يوجد به عمود به جميع أسماء عملاء الفرع بأرقام تليفوناتهم

ومن هذه العملاء عملاء يتم التعامل معهم بالفعل

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

 

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

حيث أننى جربت الكود ولم يعمل معى

أنا عارف أنى بتعب حضرتك معايا جدا جدا بس سوف يتم تطبيق هذا الشيت على 38 فرع

أشكر حضرتك على سعة صدرك

العملاء.rar

[عطاء الله]

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

السلام عليكم أخي ابو حنين

هذا حل بواسطة المعادلاات هو صحيح لكن راجعه لأن الكتابة غير متناسقة

تقبل تحياتي

ata2.rar

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

السلام عليكم

اخي ياسر جرب الكود التالي  و اخبرني هل النتائج صحيحة او لا

انسخ الكود كما هو و اربطه بزر

و ان كان هناك خطأ اخبرني اين هو

Sub NNNNNNNNN()

m = 4
Application.ScreenUpdating = False
With Sheets("العملاء")

    last = .Cells(Rows.Count, "B").End(xlUp).Row
    Dim RngB As Range
    Set RngB = .Range("B4:B" & last)
For x = 4 To last
If Application.WorksheetFunction.CountIf(RngB, .Cells(x, "E")) = 0 Then
    .Cells(m, "H") = .Cells(x, "B")
    .Cells(m, "I") = .Cells(x, "B").Offset(0, 1)
     m = m + 1
     
End If
Next x
End With

End Sub

[Yasser Fathi Albanna]

أخى الكريم الأستاذ /  أبو حنين

أنا جربت الكود فى المرفق

ولكن أنا مش عارف أربط الكود بزر

الرجاء ربط الزر فى المرفق مع إرفاقة مرة أخرى

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

العملاء.rar

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

هذا هو الملف الذي ارسلته في المشاركة رقم 11

العملاء.rar

تم تعديل ديسمبر 17, 2013 بواسطه أبو حنين

[Yasser Fathi Albanna]

تسلم إيدك أستاذى الفاضل ومعلمى القدير أخى / أبو حنين

ربنا يوفقك دائما ويجعلك من المتفوقين

[عطاء الله]

بعد إذن الأستاذ أبو حنين

أنا حشرح لك في مكانه

-* أنسخ الكود

-* أضغط ALT+F11

-* إدراج ميديول ثم ألصق الكود وأضغط F5

-*تجد ترحيل موجود وعند الإضافة العملاء 

إذهب إلى إدراج كائن إختر أي شكل ثم اضغط بالزر الأيمن للموس وإختار تعيين مكرو تجد NNNNNNNNNN ثمoK

هذا عن كيفية إدخال الكود

ملاحظة : انا لاحظت أن هناك أسماء متعامل ورحلها إلى غير متعاملة مثال  أحمد سمير الخولي متعامل من الأوئل ورحله وهناك العكس

[Yasser Fathi Albanna]

أشكرك أخى الفاضل عطا الله

وما سبب ذلك بعد إذن الأستاذ / أبو حنين

أنا لاحظت نفس العميل

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

[عطاء الله]

أبو حنين أعذرني أنا لم أنتبه إلى تدخلك ووظننت

أنك غير متصل أعذرني مرة أخرى أنا متأسف

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

العفو اخي عطاء الله

ارجو منك ان تقوم بتغيير الكود السابق في المشاركة رقم 15 بهذا الكود و اخبرني بالنتيجة

Sub sFindddd()

m = 4
Application.ScreenUpdating = False
With Sheets("ÇáÚãáÇÁ")

    last = .Cells(Rows.Count, "B").End(xlUp).Row
    Dim RngB As Range
    Set RngB = .Range("E4:E" & last)
For x = 4 To last
If Application.WorksheetFunction.CountIf(RngB, .Cells(x, "B")) = 0 Then
    .Cells(m, "H") = .Cells(x, "B")
    .Cells(m, "I") = .Cells(x, "B").Offset(0, 1)
     m = m + 1
     
End If
Next x
End With

End Sub

[عطاء الله]

أخي أبو حنين مازالت فيه عدت أخطاء

مثال على ذلك الفاروق أحمد زكي هو من العملاء المتعاملين رقم صف 50 ورحله وهناك كثر

[Yasser Fathi Albanna]

أساتذتى الكرام الأستاذ الفاضل /  أبو حنين

والأستاذ الفاضل / عطا الله

فى خطأ فى المرفق الأتى لا أعرفه

الرجاء من الأستاذ القدير / أبو حنين النظر للملف المرفق للضرورة

فيوجد به شرح الخطأ  

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

Customer.rar

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

السلام عليكم

اخي ياسر افتح الملف و اقرأ ما هو مكتوب  أولا ثم اضغط على الزر

انتظر منك  النتيجة

مثال.rar

تم تعديل ديسمبر 17, 2013 بواسطه أبو حنين

[Yasser Fathi Albanna]

أخى العزيز المحترم الأستاذ القدير / أبو حنين

تسلم إيديك أولا على هذا الكود الجميل

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

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

أتفضل بخالص الشكر والتقدير لحضرتك وأشكرك على تعبك معايا مع دوام التوفيق

وأتوجه أيضا بخالص الشكر للأستاذ الفاضل / عطا الله على مشاركته معى ومعادلاته الجميلة أيضا

كما أتوجه أيضا بخالص الشكر والتقدير لهذا المنتدى العظيم الذى تعلمت منه الكثير والكثير وما زلت أتعلم منه

مع وافر التحية للجميع

[Yasser Fathi Albanna]

أخى الفاضل الأستاذ / أطمع من حضرتك فى طلب تانى لو أمكن بعد إذن سيادتكم

الطلب بالمرفق

وهو عبارة عن مقارنة

الرجاء النظر إلى المرفق والتطبيق عليه

وشكرا لسعة صدرك

مقارنة.rar