tlayt kamal قام بنشر نوفمبر 7, 2019 مشاركة قام بنشر نوفمبر 7, 2019 السلام عليكم فضلا اريد كود يوزع القيمة في خلايا العمود D الى اللعمدة E , F,G 1مثلا ادا كانت القيمة في D اصغر من 100 تحسب في الشطر الاول 2 من 101 حتى 200 الشكر اللول والثاني 3 من 201 وما فوق الشطر الثالث واريد كمان ضرب نتائج الاشطر على الاثمنة في الخلايا L4,M4,N4 كما في المثال بالمرفق جزاكم الله خيرا حساب الاشطر.xlsm رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر نوفمبر 7, 2019 مشاركة قام بنشر نوفمبر 7, 2019 جرب هذا الملف الكود Option Explicit Function how_to_pay(Myfact#, n1#, n2#, n3#) As Double '''''''''''''''''''''''''''''''''''''''''' Dim How_Many# Select Case Myfact Case Is <= 100 How_Many = Myfact * n1 ' a Case Is <= 200 How_Many = (100 * n1) + (Myfact - 100) * n2 ' a+b Case Is > 200 How_Many = (100 * n1) + (100 * n2) + (Myfact - 200) * n3 'a+c+d End Select how_to_pay = How_Many '''''''''''''''''''''''''''''''''''''''' End Function Fatura.xlsm 1 رابط هذا التعليق شارك More sharing options...
tlayt kamal قام بنشر نوفمبر 7, 2019 الكاتب مشاركة قام بنشر نوفمبر 7, 2019 اشكرك استاذ سليم جعله الله في ميزان حسناتك بس فيه نقطة مذا عن توزيع العدد للاشطر رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر نوفمبر 7, 2019 مشاركة قام بنشر نوفمبر 7, 2019 تم توزيع الاشطر (بواسطة المعادلات) على فكرة اذا كنت تريد توزيع الاشطر اولاً فأنت لست بحاجة للماكرو كما في الورقة salim من هذا الملف Fatura_new.xlsm 1 رابط هذا التعليق شارك More sharing options...
tlayt kamal قام بنشر نوفمبر 7, 2019 الكاتب مشاركة قام بنشر نوفمبر 7, 2019 (معدل) استاذ سليم بارك الله في علمك وانتفع به كانت رغبتي ان اعمل هذا بالماكرو لان الملف فيه بيانات كثيرة ولكن ان كان ذلك غير ممكن فلا يأس تم تعديل نوفمبر 7, 2019 بواسطه tlayt kamal رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر نوفمبر 7, 2019 مشاركة قام بنشر نوفمبر 7, 2019 الماكرو ما زال يعمل كما تريد + توزيع الاشطر (الصفحة الاولى ) رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر نوفمبر 7, 2019 مشاركة قام بنشر نوفمبر 7, 2019 الملف كاملاً بواسطة الكود ما عليك الا ان تضغط الزر PRESS ME PLEAS CODE Sub get_val() Dim R#, My_Sh As Worksheet Set My_Sh = Sheets("Sheet1") R = My_Sh.Cells(Rows.Count, 3).End(3).Row With My_Sh.Range("E4").Resize(R - 3) .Resize(, 4).ClearContents .Formula = "=IF(D4<100,D4,100)" .Offset(, 1).Formula = _ "=IF(D4<=100,"""",IF(AND(D4>100,D4<200),D4-100,100))" .Offset(, 2).Formula = _ "=IF(AND(SUM(E4:F4)=200,D4>200),D4-SUM(E4:F4),"""")" .Offset(, 3).Formula = _ "=SUMPRODUCT(E4:G4,$L$4:$N$4)" .Resize(, 4).Value = .Resize(, 4).Value End With End Sub FILE INCLUDED Fatura_new_VBA.xlsm 1 رابط هذا التعليق شارك More sharing options...
tlayt kamal قام بنشر نوفمبر 7, 2019 الكاتب مشاركة قام بنشر نوفمبر 7, 2019 نعم استاذي هذا ما اريد بالظبط جزاك الله خيرا رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر نوفمبر 7, 2019 أفضل إجابة مشاركة قام بنشر نوفمبر 7, 2019 هذا ماكرو اخر يعتمد على المصفوفات (يجب ان يكون اسرع بكثير خاصة اذا كانت البيانات كثيرة ) لا وجد لاي معادلة Option Explicit Sub get_val_BY_ARRYS() Dim My_Sh As Worksheet Dim ARR, S#, T#, R#, I#, k As Byte Set My_Sh = Sheets("Sheet1") R = My_Sh.Cells(Rows.Count, 3).End(3).Row My_Sh.Range("E4").Resize(R - 3, 4).ClearContents For I = 4 To R With My_Sh.Range("D" & I) If Not IsNumeric(.Value) Then GoTo next_i Select Case .Value Case Is < 100: ARR = Array(.Value, "", "") Case Is < 200: ARR = Array(100, .Value - 100, "") Case Is > 200: ARR = Array(100, 100, .Value - 200) End Select .Offset(, 1).Resize(, 3).Value = ARR For k = LBound(ARR) To UBound(ARR) If IsNumeric(ARR(k)) Then T = ARR(k) * Range("L4").Offset(, k) Else T = 0 End If: S = S + T Next .Offset(, 4) = S: S = 0 End With next_i: Next End Sub 2 رابط هذا التعليق شارك More sharing options...
tlayt kamal قام بنشر نوفمبر 11, 2019 الكاتب مشاركة قام بنشر نوفمبر 11, 2019 استاذي اعتدر عن تأخري في الرد لظروف قاهرة جزاك الله خيرا ومتعك بنعمة الاسلام وصحة البدن رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر نوفمبر 11, 2019 مشاركة قام بنشر نوفمبر 11, 2019 استاذ سليم بارك الله فيكم ماذا تعنى علامة الشباك فى المتغيرات الرقم 3 فى الحصول على اخر رقم بديل xlup الكود ممتاز يا ريت تفدنا من علمك بشرح الكود على الاسطر تحياتى لشخصكم الكريم رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان