أ / محمد صالح

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

ويمكن اختصار الكود إلى
Sub mas160menu() Dim Ws As Worksheet, Sh As Worksheet Dim I As Long, x As Long, n As Long, Lr As Long, c As Integer Set Ws = Sheets("السجل الكلي"): Set Sh = Sheets("قوائم80") Lr = Ws.Cells(Rows.Count, 4).End(xlUp).Row Application.ScreenUpdating = False Sh.Range("C7:F86,H7:K86").ClearContents For t = 1 To 2 1: x = (t - 1) * 40 + 7 For I = n + 9 To Lr If Ws.Cells(I, 6).Value = Sh.Range("D1").Value And Ws.Cells(I, 7).Value = Sh.Range("E1").Value Then Sh.Cells(x, IIf(c Mod 2, 8, 3)).Value = Ws.Cells(I, 4).Value Sh.Cells(x, IIf(c Mod 2, 9, 4)).Resize(1, 2).Value = Ws.Cells(I, 10).Resize(1, 2).Value Sh.Cells(x, IIf(c Mod 2, 11, 6)).Value = Ws.Cells(I, 13).Value If x = t * 40 + 6 Then n = I - 8: c = c + 1 If c Mod 2 Then GoTo 1 Else GoTo 2 End If: End If x = x + 1: n = I + 1 End If Next I 2: Next t Application.ScreenUpdating = True MsgBox "Done by mr-mas.com" End Sub ويجب إعادة تعيين الماكرو للزر مع الاسم الجديد
وهذا ملفك بعد التعديل .. بالتوفيق
تعديل كود القوائم.xls

يمكنك استعمال هذا الإجراء
وربطه بشكل أو زر في شيت سجل قيد بيانات
Sub mas_getdata() Dim sh As Worksheet, n As Long, lr As Long, lr2 As Long Set sh = Sheets("data") lr = sh.Cells(Rows.Count, 2).End(xlUp).Row Application.ScreenUpdating = 0 Range("b17:s218").ClearContents For n = 9 To lr If sh.Range("f" & n) = [e2] And sh.Range("g" & n) = [e3] Then lr2 = Cells(Rows.Count, 2).End(xlUp).Row + 1 lr2 = IIf(lr2 < 17, 17, lr2) For c = 2 To 19 Cells(lr2, c) = sh.Cells(n, Cells(1, c)) Next c End If Next n Application.ScreenUpdating = 1 MsgBox "Done by mr-mas.com" End Sub ملحوظة: تم استخدام الأرقام في الصف الأول في الكود فلا يجب مسحها
يمكن إخفاء الصف
بالتوفيق

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

ربما يكون هذا هو المطلوب .. تم إضافة تاريخ السداد المبكر في الخلية L15
تعديل معادلة العمود  B & C
تعديل معادلة الأشهر المسددة .. بالتوفيق
‫المثال ء _2.xlsm

يبدو أن حضرتك ما ضغطت على الرابط الموجود في كلمات (استعمال محرك البحث) في مشاركتي الأولى
على العموم 
أحد الحلول الموجودة في نتائج البحث:
أن تضع كود فك الحماية في بداية الإجراء بعد sub name-of-sub
وتعود لتضع كود الحماية في نهايته قبل end sub
بالتوفيق 

يمكنك استعمال هذا الكود
textbox1.value = sheets("ليذجر").cells(rows.count,5).end(xlup).value بالتوفيق 

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

المشكلة في هذا السطر في حدث بعد تحديث مربع النص
Me.TextBox2 = Application.VLookup(Val(Me.TextBox1), Sheets("cod").Range("c5:e5000"), 2, 0) حيث يتم البحث حتى صف 5000 والرقم المطلوب في الصف 7152
لذلك يلزمك زيادة صف النهاية إلى 10000 مثلا

تفضل هذا ملفك بعد إضافة الكود
وتعديل أسماء الشيتات من المسافات الزائدة
وتعديل الأعمدة التي سيتم الترحيل لها
حيث كان بها خلايا في الأسفل (مكتوب فيها) تمنع من دقة معرفة آخر صف مكتوب فيه
بالتوفيق
البرنامج 1-1.xlsm

هذه أساسيات الدوال
للحصول على أصغر قيمة نستعمل min
=MIN(A2:B2) بالتوفيق 

إن شاء الله تفيدك هذه المواضيع

الفكرة تكررت في موضوعات كثيرة
ويجب أ ن نتعلم مما سبق
 

كلامي عن الخطأ في المشاركة الأولى لك
وبالنسبة لتعديل المعادلة جرب هذه
=If(MOD(A1,B1)=0,B1,MOD(A1,B1)) بالتوفيق 

بعد إذن صديقي بن علية طبعا
تفضل أخي الكريم 
هذه فكرتي في تنفيذ المطلوب
في شيت 2
ولكن أنصح بوضع الرقم الأكبر 10 تحت خانة الطول والرقم الأصغر 8 تحت خانة العرض حتى تحصل على أفضل النتائج 
بالتوفيق 
mas_cut_draw.xlsb

المشكلة في رقم الصف الذي يجلب بياناته ويضعها على الزر
لاحظ هذا السطر
Controls("C" & I).Caption = SH.Range("b" & I ) يجلب الصفوف من 1 إلى 20 من العمود B مع ملاحظة أن الأصناف تبدأ من الصف 3 لذلك ينبغي إضافة 2 ليصبح الكود
Controls("C" & I).Caption = SH.Range("b" & I + 2) ونفس الشيء في هذا السطر
Controls("Command" & I).Caption = SH.Range("g" & I ) وينبغي إضافة 1 لأن صف العنوان غير مطلوب ليصبح الكود
Controls("Command" & I).Caption = SH.Range("g" & I + 1) بالتوفيق 

الأمر بسيط جدا
أن تضيف شرطا إذا كانت الدرجة فارغة فالنتيجة فارغة
يمكنك استعمال هذه المعادلة في D4
=IF(C4="","",IF(C4>=60,"ناجح","راسب")) بالتوفيق 

حسب فهمي للمطلوب أنك تريد وضع معادلة مضمونها
إذا كانت القراءة الحالية والسابقة موجودة يقوم بطرحهما
واذا لم يكونا موجودين يضرب D5*J5*I5
ويحولها إلى قيم
في هذه الحالة لا نحتاج لترحيل حاصل الطرح 
ولا نحتاج textbox3 في النموذج 
بالتوفيق 
wor.xlsm

يمكنك استعمال هذا الشرط بدلا من السطر المذكور
If IsDate(Txt2) then .Range("H" & lastRow).Value = CDate(Txt2) بالتوفيق

تم عمل المطلوب حرفيا بغض النظر عن عدم الرد على الاستيضاح السابق
بالتوفيق
Store4 - Copy.xlsm

جرب استعمال هذ الكود في حدث عند تغيير محتوى الخلية
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count = 1 And Target.Column = 1 Then If Target.Value <> "" Then If Not Sheets("الارشيف").Range("a:a").Find("*" & Target & "*") Is Nothing Then If MsgBox("هذا الكود موجود. هل تريد إدخاله؟", 292, "انتبه") = vbNo Then Target.Select: Target.Value = "" End If: End If: End If: End If End Sub ولا تنس حفظ الملف بامتداد يدعم الكود مثل xlsb
بالتوفيق

بإذن الله هذ الكود يقوم بهذا الترتيب
Sub mas_order() For n1 = 1 To 10 Range("a" & n1 * 8 - 4).Value = n1 For n2 = 1 To 3 Range("b" & n1 * 8 - 4 + n2 * 2).Value = n2 * 1000 - 1000 + n1 Next n2: Next n1 MsgBox "Done" End Sub مع إمكانية التحكم في نهاية الترقيم في العمود A بنهاية المتغير n1 في الحلقة التكراربة (حاليا 10)
بالتوفيق

إن شاء الله تفيدك هذه المعادلات البسيطة 
حساب تاريخ المعاش.xlsx

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

أخي الكريم
الكود لا يحدد الملف مصدر الأرقام والرسائل
الكود يقرأ محتويات الصف السادس حتى الصف 55 في العمود 8 الذي اسمه H والعمود 9 والذي اسمه I من الشيت النشط
وبالنسبة لعدم وصول نص الرسالة كاملا
تم التغلب عليها بكتابة نص الرسالة في مربع الارسال تلقائيا وعدم إرسالها في الرابط
Sub WhatsApp() Dim Contact As String, Message As String Dim n As Long For n = 6 To 7 Contact = Cells(n, 8).Value Message = Cells(n, 9).Value If Contact <> 0 And Message <> "" Then Shell "explorer ""whatsapp://send?phone=" & Contact & """", vbNormalFocus Application.Wait Now() + TimeSerial(0, 0, 5) SendKeys Message Application.Wait Now() + TimeSerial(0, 0, 3) SendKeys "~" Application.Wait Now() + TimeSerial(0, 0, 3) End If Next n MsgBox "Done!" End Sub لاحظ تم حذف المتغير message من رابط الإرسال وكتابته عن طريق الأمر sendkeys
وبالنسبة لاحتمالية عدم وجود رقم تم وضع شرط
عدم فراغ خلية الرسالة وعدم وجود صفر فقط في خلية الرقم
بالتوفيق