Yasser Fathi Albanna

شكرا لمرورك العطر أخى / abouelhassan تقبل خالص تحياتى وتقديرى

حبيبى الغالى أستاذى ومعلمى القدير / ياسر خليل الذى مجرد مرورة على موضوع لى شرف لى الطلب واضح أخى الحبيب فى المرفق وسأوضحة ثانية يوجد بالملف المرفق تقرير سيستم وبجوارة Rank قمت بتصميمة به ثلاثة خانات الخانة الأولى و هى To وهى عبارة عن إجمالى مبيعات المندوب وهى تعمل بكفائة عن طريق الكود الذى تفضل الأستاذ القدير / العيدروس بصياغته لى الخانة الثانية وهى P C وهى عبارة عن الزيارات الإجابية التى يحققها المندوب وهى الخانة المراد بها التعديل داخل الكود الذى تفضل الأستاذ القدير بصياغته لى لتعطى النتيجة الأتية وهى ( وهى أننى أريد وضع العميل فقط فى هذه الخانة حسب التاريخ أى أن العميل فرضا لو إسمه ياسر وسحب يوم 01/11/2015 وسحب فى نفس اليوم 50 مرة يعد مرة واحدة فقط وإذا سحب يوم 02/11/2015 مرة ثانية وأيضا تكرر فى نفس اليوم 50 مرة أيضا يحسب مرة واحد يبقى إجمالى اليومين 2 فقط زيارة إجابية وموضح بالمرفق النتيجة المطلوبة ) الخانة الثالثة وهى LPC وهى عبارة عن الأصناف المباعة للمندوب حتى ولم مكررة وهى مضبوطة داخل الكود الذى تفضل به الأستاذ القدير / العيدروس بصياغته لى الخانة الرابعة وهى EC وهى عبارة عن عدد العملاء المتعاملين مع المندوب بدون تكرار والنتيجة مضبوطة أيضا داخل الكود الذى تفضل به الأستاذ القدير / العيدروس بصياغته لى وشكرا مرفق التقرير والرانك وموضح به النتائج المطلوبة Rank.rar

شكرا لمرورك العطر أخى الكريم / هاشم بركات

اللهم يسر ولا تعسر اللهم أمين للرفع أثابكم الله وجزاكم الله خير

للرفع جزاكم الله خير الجزاء

للرفع

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

وأيضا أخى الحبيب / عبد العزيز DigitalClock.rar

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

وأيضا clocks.rar

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

ولإثراء الموضوع هذه أداة Add-Ins تضاف داخل الإكسيل وتظهر الساعة الرقمية أيضا TMDigitalClock.zip

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

بارك الله فيك أخى الحبيب وائل احمد المصري هدية مقبولة وشرح رائع جزاك الله كل الخير وأدام عليك الصحة والعافية

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

السلام عليكم ورحمة الله وبركاته أحبائى أعضاء وأساتذة هذا الصرح العلمى الكبير تحية طيبة وبعد سؤال كثيرا منا يتسائل ما هى أسباب وضع فاصلة أم فاصلة منقوطة في معادلات الإكسل؟ هل تذكر أول مرة كتبت فيها معادلة أو دالة Function في برنامج إكسل، وخاصة إذا كنت تعلمتها بطريقة نظرية – وليست عملية – يعني مكتوبة على ورق وحفظتها وفهمتها ثم تبدأ بالتطبيق العملي باستخدام برنامج الإكسل. ببساطة أنت تبدأ بكتابة المعادلة كما تعلمتها بالضبط، وتحاذر الخطأ، لكن مرة بعد مرة تظهر لك رسالة خطأ السبب بسيط، وهو أنك كتبت فاصلة (,) Comma وكان يجب أن تكتب بدلا منها فاصلة منقوطة (;) Semi-Colon أو العكس. إذًا لماذا تكتب المعادلة نفسها على جهاز آخر بنفس الخطأ، ولا تظهر رسالة خطأ وتسير الأمور بصورة طبيعية وينتج ناتج الدالة بشكل صحيح. لا تنزعج، وتقول عيب الجهاز. يرجع الأمر إلى أن الإعدادات في لوحة التحكم ببرنامج ويندوز Windows قد تختلف من جهاز لآخر. على كل حال إذا أردت من برنامج الإكسل أن يقبل منك الفاصلة في المعادلات أو الفاصلة المنقوطة بدلا منها، فعليك بعمل ذلك مرة واحدة من لوحة التحكم افتح لوحة التحكم من قائمة إبدأ ثم لوحة التحكم. اختر التاريخ والوقت. Date, Time, Language, and Regional Options اختر تغيير تنسيق الأرقام والتواريخ والأوقات. Change the format of numbers, dates, and times اختر تخصيص Customize اكتب في خانة فاصل القائمة List separator أكتب فاصلة أو اكتب فاصلة منقوطة، كما تريد. فهذه الفاصلة أو الفاصلة المنقوطة هي ما ستكتب به المعادلات في الإكسل. انقر موافق Ok ثلاث مرات. انتهي

للرفع أثابكم الله

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

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

جزاك الله خيرا

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

جزاك الله خيرا أخى/ مختار البركانى

أخى الحبيب / ابو القبطان شرفت بمرورك وكلامك الرائع

شكرا لمرورك العطر أخى أو أنس تقبل تحياتى

السلام عليكم ورحمة الله وبركاته إخوانى وأحبائى أعضاء وأساتذة ونجوم هذا الصرح العلمى العالمى العظيم بعد التحية قمت بطرح موضوع سابق من قبل طلبت فيه سحب بيانات معينة من تقرير لتقرير معين وتفضل الأستاذ القدير الفاضل / العيدروس بعمل لى هذا الكود العظيم وكان الكود رائع ولكنى أريد تعديل بسيط يقوم بتغيير نتيجة خانة معينة فى الشيت المطلوب نقل البيانات به إلى نتيجة معينة وباقى الخانات المطلوب بها النتائج ستظل كما هى موضح بالمرفق المطلوب الكود هو : 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 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 X = IIf(Vl = 3, X + 1, IIf(Vl = 4, X + Ar(R, 6), X + 1)) 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 R, Rr, Cll Set Sh = Sheets("Rank") With Sh 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 وتفضل أيضا الأخ الحبيب أستاذى ومعلمى القدير / ياسر خليل بتعديل طفيف فى الكود لتسريعة وكانت أيضا نتيجته ممتاذة والكود هو : Sub Test() Dim Coll As New Collection, CollDummy1 As New Collection, CollDummy2 As New Collection Dim ArrData, ArrIn, ArrOut1(), ArrOut2(), ArrOut3(), ArrOut4(), ArrCalc(), ArrTemp Dim I As Long, P As Long With Sheets("Report") ArrData = .Range("A2:F" & Application.Max(.Cells(.Rows.Count, "A").End(xlUp).Row, 2)) End With With Sheets("Rank") ArrIn = .Range("B10:B" & Application.Max(.Cells(.Rows.Count, "A").End(xlUp).Row, 10)) End With ReDim ArrOut1(1 To UBound(ArrIn, 1), 1 To 1) ReDim ArrOut2(1 To UBound(ArrIn, 1), 1 To 1) ReDim ArrOut3(1 To UBound(ArrIn, 1), 1 To 1) ReDim ArrOut4(1 To UBound(ArrIn, 1), 1 To 1) ReDim ArrCalc(1 To UBound(ArrData, 1), 1 To 2) On Error Resume Next For I = 1 To UBound(ArrData, 1) Set CollDummy1 = Nothing Set CollDummy2 = Nothing Coll.Add Key:=ArrData(I, 3), Item:=Array(Coll.Count + 1, CollDummy1, CollDummy2) ArrTemp = Coll(ArrData(I, 3)) ArrTemp(1).Add Key:=ArrData(I, 4), Item:=Empty ArrTemp(2).Add Key:=ArrData(I, 1), Item:=Empty P = ArrTemp(0) ArrCalc(P, 1) = ArrCalc(P, 1) + ArrData(I, 6) ArrCalc(P, 2) = ArrCalc(P, 2) + 1 Next I On Error GoTo 0 For I = 1 To UBound(ArrIn, 1) On Error Resume Next ArrTemp = Coll(ArrIn(I, 1)) If Err.Number = 0 Then ArrOut1(I, 1) = ArrCalc(ArrTemp(0), 1) ArrOut2(I, 1) = ArrCalc(ArrTemp(0), 2) ArrOut3(I, 1) = ArrTemp(1).Count ArrOut4(I, 1) = ArrTemp(2).Count End If On Error GoTo 0 Next I Application.ScreenUpdating = False With Sheets("Rank") .Range("D10").Resize(UBound(ArrOut1, 1), 1).Value = ArrOut1 .Range("I10").Resize(UBound(ArrOut2, 1), 1).Value = ArrOut2 .Range("N10").Resize(UBound(ArrOut3, 1), 1).Value = ArrOut3 .Range("S10").Resize(UBound(ArrOut4, 1), 1).Value = ArrOut4 End With Application.ScreenUpdating = True End Sub الرجاء المساعدة ولكم خالص الشكر والتقدير Rank.rar