Yasser Fathi Albanna

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

سلمت يمينك أخى الحبيب / سليم رائــــــــــــــــــــــــــــع جزاك الله خيرا

أ / بن على أردت تطبيق معادلة حضرتك على الملف المرفق ولم أنجح ولا أدرى ما المشكلة الرجاء النظر للمرفق لمعرفة السبب ولسيادتكم خالص الشكر والتقدير Rank.rar

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

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

أخى الأستاذ والمعلم القدير زالحبيب / بن علية حاجى فى البداية أشكر حضرتك على إهتمامك ولكن يوجد ملحوظة بالمرفق أرجو النظر إليها وشكرا Rank.rar

للرفع ولكم خالص الشكر والتقدير

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

السلام عليكم ورحمة الله وبركاته تحياتى للجميع وبعد مرفق ملف به المطلوب ولكم خالص الشكر والتقدير Rank.rar

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

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

دا لسه فى اجزاء ناقصة تانى

سلمت يمينك أخى الحبيب تقبل خالص تحياتى وتقديرى

أخى الحبيب أ/ أحمد الفلاحجى جزاك الله كل خير وشكر لتعب حضرتك معايا بس لسه فى جزء رابع سلمت يمينك

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

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

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

السادة الأفاضل بعد التحية هل يمكن عمل مثل المرفق على الأكسيس دا مجرد مثال من على النت صور عبارة عن كمثال عندما أضغط على زر يدخلنى على مرحلة ثانية بها أزرار ببيانات وهكذا مرفق مثال مثال.rar

الله ينور أخى الحبيب / عبد العزيز رائــــــــــــــــــــــــــــع تقبل تحياتى

حبيبى الغالى / عبد العزيز ربنا ما يحرمنيش منك أبدا أشكرك لإهتمامك تقبل خالص تحياتى وتقديرى فى إنتظار رد العمالقة أو يتفضل الأستاذ القدير / العيدروس بتعديل المطلوب مع خالص شكر وتقديرى للجميع

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

السلام عليكم ورحمة الله وبركاته إخوانى وأحبائى الأعزاء أعضاء وأساتذة عالم العلم والمعرفة بأوفيسينا تحية طيبة وبعد كنت قد طرحت موضوع من قبل عبارة عن Rank يسحب داتا معينة من Report وقام السيد الفاضل الأستاذ القدير / العيدروس بعمل لى كود أكثر من روعة وقمت بطرح هذا الكود للتعديل عليه مرة أخرى لسحبها بطريقة ما وتفضل أيضا أستاذى ومعلمى القدير / العيدروس بتعديلة اليوم أطرح نفس الكود لتعديل جزء بسيط به خاص بخانة معينة داخل Rank مظللة باللون الأصفر لتعطى النتيجة الموضحة داخل اللون الأصفر وهى عبارة عن جميع الأصناف المباعة للمندوب حتى لو مكررة أى كاملة مرفق الملف وبه الكود وأيضا الكود موضح الرجاء المساعدة ولسيادتكم خالص الشكر والتقدير مع وافر التحية Private Function Ali(Ln As Long, Vl, Bl As String, Bln As Boolean) Dim Shet As Worksheet Dim Do_Ali Dim Ar() As Variant Dim iCnt& Dim X, A On Error Resume Next Set Shet = Sheets("Report") Set Do_Ali = CreateObject("Scripting.Dictionary") With Application .ScreenUpdating = False .EnableEvents = True DoEvents With Shet Lr = .Cells(.Rows.Count, 2).End(xlUp).Row Ar = .Range("A2:F" & Lr).Value: A = Bl For R = LBound(Ar, 1) To UBound(Ar, 1) If Ar(R, 3) = A Then If Not Bln Then If Vl = 3 Then ZZ = Ar(R, 2): ZZZ = Ar(R - 1, 2) If ZZZ <> ZZ Then X = X + 1 End If End If If Vl = 4 Then X = X + Ar(R, 6) End If End If If Do_Ali.exists(Ar(R, Ln)) Then Do_Ali.Item(Ar(R, Ln)) = Do_Ali.Item(Ar(R, Ln)) + 1 Else Do_Ali.Add Ar(R, Ln), 1 End If End If Next Ali = IIf(Vl = 1, Do_Ali.Count, X) End With .ScreenUpdating = True .EnableEvents = False End With Erase Ar Set Do_Ali = Nothing Set Shet = Nothing End Function Sub Ali_Count() Dim Sh As Worksheet Dim Sht As Worksheet Dim R, Rr, Cll, Lrr Set Sh = Sheets("Rank") Set Sht = Sheets("Report") With Sh Lrr = Sht.Cells(Rows.Count, 2).End(xlUp).Row Sht.Sort.SortFields.Add Key:=Sht.Range("A2:A" & Lrr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With Sht.Sort .SetRange Sht.Range("A1:F" & Lrr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Rr = 10: Cll = 13 For R = Rr To Cll If .Cells(R, 2) <> "" Then .Cells(R, 4) = Ali(1, 4, .Cells(R, 2), False) .Cells(R, 9) = Ali(1, 3, .Cells(R, 2), False) .Cells(R, 14) = Ali(4, 1, .Cells(R, 2), True) .Cells(R, 19) = Ali(1, 1, .Cells(R, 2), True) End If Next End With MsgBox "Greetings with Engineer / Yasser Fathi Al-Banna " End Sub Rank End.rar

الله أكبر الله أكبر الله أكبر تجمع الأخوة الأحباء على قول لا إله إلا الله محمد رسول الله شرفت بمروركم جميعا أحبائى فى الله حبيبى الغالى / ياسر العربى حبيبى الغالى / محمد الخازمي حبيبى الغالى / عبد العزيز البسكرى حبيبى وأستاذى ومعلمى القدير / ياسر خليل تقبلوا جميعا تحياتى وتقديرى

السلام عليكم ورحمة الله وبركاته تحياتى وتقديرى لجميع أحبائى أعضاء وأساتذة هذا الصرح العلمى الهائل أدخل المعادلة الأتية بأى خلية داخل الإكسيل وشاهد النتيجة بنفسك تحياتى =CHAR(225)&CHAR(199)&CHAR(32)&CHAR(197)&CHAR(225)&CHAR(229)&CHAR(32)&CHAR(197)&CHAR(225)&CHAR(199)&CHAR(32)&CHAR(199)&CHAR(225)&CHAR(225)&CHAR(229)&CHAR(32)&CHAR(227)&CHAR(205)&CHAR(227)&CHAR(207)&CHAR(32)&CHAR(209)&CHAR(211)&CHAR(230)&CHAR(225)&CHAR(32)&CHAR(199)&CHAR(225)&CHAR(225)&CHAR(229)

اخى الحبيب الغالى / ياسر العربى ما شاء الله عليك شرحك وأسلوبك فى توصيل المعلومة رائع زادك الله من العلم الكثير والكثير وأدام عليك الصحة والعافية تقبل خالص تحياتى وتقديرى