أ / محمد صالح

يمكنك استعمال دالة sumifs للجمع باكثر من شرط
في الخلية D6
=SUMIFS(Data!D:D,Data!C:C,C6,Data!A:A,">="&$C$4,Data!A:A,"<="&$E$4) بالتوفيق

عليكم السلام ورحمة الله وبركاته
يمكنك استعمال هذه المعادلة في الخلية B2 وسحبها يمينا ثم أسفل
=IF(AND(B$1>=main!$B3,B$1<=main!$C3),B$1,"") وتعني إذا كان التاريخ المكتوب في B1 أكبر من أو يساوي تاريخ بداية المدة وأقل من أو يساوي تاريخ نهاية المدة يتم كتابة هذا التاريخ وإلا تظهر الخلية فارغة
مع تغيير تنسيق الخلايا إلى تاريخ
بالتوفيق

* يمكنك ضبط تنسيق الخلايا إلى احتواء تلقائي shrink to fit
وذلك بتحديد الخلايا المطلوب تنسيقها ثم كلك يمين ثم تنسيق الخلايا format cells ومن التبويب الثاني تحتار احتواء مناسب shrink to fit
* وتصغير عرض الأعمدة يدويا إلى أن تظهر كاملة من خلال الضغط مع السحب على الخط الفاصل بين العمودين بعد تحول السهم إلى سهمين متقابلين أفقيا
وللعلم هذه اساسيات التعامل مع إكسل
ينبغي تعلمها قبل تصميم أي يبرامج
بالتوفيق

هذه الميزة متوفرة في تطبيق الصور photos في ويندوز 10
يمكنك مراجعة هذا الرابط
بالتوفيق

يمكنك استعمال هذا الكود لحذف أقدم التكرارات
Sub DeleteOldestRepeated() lr = Cells(Rows.Count, 3).End(xlUp).Row For r = 2 To lr If Evaluate("=COUNTIF($C$2:$C$" & lr & ",C" & r & ")") > 1 Then For n = (r + 1) To lr If Range("c" & n).Value = Range("c" & r).Value Then If Range("b" & n).Value >= Range("b" & r).Value Then Rows(r & ":" & r).Delete Shift:=xlUp r = r - 1 Else Rows(n & ":" & n).Delete Shift:=xlUp End If End If 'Exit For Next n End If Next r MsgBox "Done by mr-mas.com" End Sub وإذا كانت احتمالات التكرارات مرتين فقط في الاسم الواحد فيمكن حذف علامة التعليق قبل exit for لتسريع الكود أكثر
بالتوفيق

كما توقعت
المشكلة في نوع بيانات الخلايا D2:G601 حيث أنها نص text وليست رقما number
لذلك يجب تحديد النطاق المطلوب ثم الضغط على المثلث الأصفر الذي يظهر أنه يوجد خطأ في هذه الخلايا ثم اختيار تحويل إلى رقم convert to number
بعدها أي معادلة سيتم استعمالها وسحبها لأسفل ستعمل بنجاح
وهذا ملفك بعد تنفيذ هذه الخطوات
بالتوفيق
 
الافواج - Copie.xlsx

حسب فهمي للمطلوب يمكنك استعمال هذا السطر لتنسيق قيمة الخلية وعرضها باثميم من المنازل العشرية
Me("txtQty" & AD) = Format(Sheet1.Cells(i, 3), "0.00") ولا أدري ما سبب تكرار سطور الكود
يكتفي بأول أربعة فقط
Private Sub CommandButton1_Click() For i = 8 To 40 If Sheet1.Cells(i, 1) = Val(Me.TxtSearch) Then AD = AD + 1 Me("txtItem" & AD) = Sheet1.Cells(i, 2) Me("txtQty" & AD) = Format(Sheet1.Cells(i, 3), "0.00") Me("txtPrice" & AD) = Format(Sheet1.Cells(i, 4), "0.00") Me("txtTotal" & AD) = Sheet1.Cells(i, 5) End If Next i End Sub بالتوفيق

إذا كنت تقصد أن عدد الاحتياطي زاد عن الواحد في كل مجموعة في المادة الواحدة
فهنا يجب أن تتغير المعادلة لأن المعادلة الأولى تجلب أول اسم أمامه ( ح ) فقط
على العموم
تم تعديل المعادلة في الجزء العلوي بحيث يتم سحبها أفقيا ورأسيا بسهولة بدلا من استعمال معادلة مختلفة لكل صف وإضافة معادلة الاحتياطي لأكثر من واحد
يمكنك استعمال هذه المعادلة في الخلية C4 وسحبها أفقيا ورأسيا حتى K27
=IF(MOD(ROW(),2),INDEX(data!$C$19:$C$32,MATCH($B3,data!D$19:D$32,0)),INDEX(data!$C$4:$C$17,MATCH($B4,data!D$4:D$17,0))) وهذه معادلة الاحتياطي في الخلية D28 ويمكن سحبها أفقيا ورأسيا حتى K31
=IFERROR(INDEX(data!$C$4:$C$32,SMALL(IF(data!D$4:D$32=$B$28,ROW($1:$29)),ROW()-27)),"") بالتوفيق

الموضوع كما قلت حضرتك بسيط جدا ولا يحتاج استيراد ولا تصدير ولا معادلات
فقط تقوم بتصفية filter الاسم المطلوب
ثم طباعة على طابعة الويندوز pdf أو استعمال كود تصدير الشيت النشط إلى pdf
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "/" & Filename & ".pdf", , , False بالتوفيق

لا يوجد في الكود شيء يخص طريقة البحث
الكود للبحث بأول الخلية فقط
للوصول للمطلوب يمكنك تغيير هذا السطر
If Trim(c) Like TextBox28 & "*" Then إلى
If Trim(c) Like IIf(Me.OptionButton2, "*", "") & TextBox28 & "*" Then وإضافة هذين الحدثين عند الضغط على طريقة البحث
Private Sub OptionButton1_Click() TextBox28_Change End Sub Private Sub OptionButton2_Click() TextBox28_Change End Sub بالتوفيق

ولماذا حذفت الكود كله؟
يمكنك الاستفادة من هذا الموضوع في تشغيل الساعة 
مع القدرة على العمل في الملف بصورة طبيعية
بالتوفيق

يمكنك استعمال هذه المعادلة في الخلية H4 مع سحبها لأسفل
=IF(IF(MOD(ROW(),3)=1,$H$1,IF(MOD(ROW(),3)=2,$H$2,$H$3))<>500,0,F4+G4) وتعني لو باقي قسمة رقم الصف الحالي على3 يساوي 1 يستعمل الخلية h1 ولو الباقي 2 يستعمل h2 وهكذا
بالتوفيق

يمكنك استعمال هذه المعادلة في الخلية H4 مع سحبها لأسفل
=IF(IF(MOD(ROW(),3)=1,$H$1,IF(MOD(ROW(),3)=2,$H$2,$H$3))<>500,0,F4+G4) وتعني لو باقي قسمة رقم الصف الحالي على3 يساوي 1 يستعمل الخلية h1 ولو الباقي 2 يستعمل h2 وهكذا
بالتوفيق

يمكنك استعمال هذه المعادلة في الخلية H4 مع سحبها لأسفل
=IF(IF(MOD(ROW(),3)=1,$H$1,IF(MOD(ROW(),3)=2,$H$2,$H$3))<>500,0,F4+G4) وتعني لو باقي قسمة رقم الصف الحالي على3 يساوي 1 يستعمل الخلية h1 ولو الباقي 2 يستعمل h2 وهكذا
بالتوفيق

جرب استعمال هذا السطر
Private Sub comboBox1_Change() TextBox1.Value = Evaluate("=MAXIFS(Sheet2!A:A,Sheet2!C:C,""" & ComboBox1.Value & """)+1") End Sub باستعمال maxifs تقريبا تعمل في اوفيس 2013 وما بعده 
ويمكن استعمال هذا السطر لنسخ الأوفيس القديمة 
TextBox1.Value = Evaluate("=MAX(IF(""" & ComboBox1.Value & """=(Sheet2!C$2:C$100),(Sheet2!A$2:A$100)+1,1))") بالتوفيق

يمكنك استعمال هذه المعادلة في الخلية E44 للحصول على القروش
=IF(A44>=E43,0,100)+A44-E43 وهذه المعادلة في F44 للحصول على الجنيهات
=B44-IF(A44>=E43,0,1)-F43 بالتوفيق

لعل هذا هو المطلوب
تم استعمال الخلية T1 لاختيار طريقة الطباعة فردي أو جماعي
تغيير كود الاجراء text إلى
Sub text() printtype = N.Range("t1") If printtype = "فردي" Then x = InputBox("من فضلك ادخل الرقم القومى مع تحياتى اشرف صبور ") N.Range("t2") = x On Error GoTo mm i = Application.WorksheetFunction.Match(N.Range("t2"), DB.Range("c:c"), 0) Call filldata(i) N.PrintPreview Call cler Exit Sub mm: MsgBox "الرقم القومى غير موجود مع تحياتى اشرف صبور" Else lr = DB.Cells(Rows.Count, 3).End(3).Row For r = 13 To lr filldata (r) ActiveSheet.PrintOut Next r Call cler End If End Sub وفي حالة اختيار جماعية يتم طباعة الأرقام من الصف 13 إلى آخر صف مكتوب فيه
lr = DB.Cells(Rows.Count, 3).End(3).Row For r = 13 To lr وحتى لا نكرر كود تعبئة الخلايا تم فصل كود التعبئة في إجراء منفصل مع تمرير رقم الصف المراد طباعته إليه
Sub filldata(i) N.Range("c7") = DB.Cells(i, "g") N.Range("c8") = DB.Cells(i, "ci") N.Range("g7") = DB.Cells(i, "b") N.Range("g8") = DB.Cells(i, "c") N.Range("c9") = DB.Cells(i, "f") N.Range("c13") = DB.Cells(i, "i") N.Range("e13") = DB.Cells(i, "j") N.Range("b16") = DB.Cells(i, "l") N.Range("c16") = DB.Cells(i, "m") N.Range("d16") = DB.Cells(i, "n") N.Range("b22") = DB.Cells(i, "af") N.Range("b23") = DB.Cells(i, "ao") N.Range("b24") = DB.Cells(i, "ax") N.Range("b25") = DB.Cells(i, "bg") N.Range("d20") = DB.Cells(i, "q") N.Range("d21") = DB.Cells(i, "y") N.Range("d22") = DB.Cells(i, "ah") N.Range("d23") = DB.Cells(i, "aq") N.Range("d24") = DB.Cells(i, "az") N.Range("d25") = DB.Cells(i, "bi") N.Range("d26") = DB.Cells(i, "bq") N.Range("d27") = DB.Cells(i, "by") N.Range("d29") = DB.Cells(i, "cf") N.Range("g20") = DB.Cells(i, "w") N.Range("g21") = DB.Cells(i, "ae") N.Range("g22") = DB.Cells(i, "an") N.Range("g23") = DB.Cells(i, "aw") N.Range("g24") = DB.Cells(i, "bf") N.Range("g25") = DB.Cells(i, "bo") N.Range("g26") = DB.Cells(i, "bw") N.Range("g27") = DB.Cells(i, "ce") N.Range("g28") = DB.Cells(i, "k") N.Range("f29") = DB.Cells(i, "cg") N.Range("e20") = DB.Cells(i, "s") N.Range("e21") = DB.Cells(i, "aa") N.Range("e22") = DB.Cells(i, "aj") N.Range("e23") = DB.Cells(i, "as") N.Range("e24") = DB.Cells(i, "bb") N.Range("e25") = DB.Cells(i, "bk") N.Range("e26") = DB.Cells(i, "bs") N.Range("e27") = DB.Cells(i, "ca") N.Range("f20") = DB.Cells(i, "t") N.Range("f21") = DB.Cells(i, "ab") N.Range("f22") = DB.Cells(i, "ak") N.Range("f23") = DB.Cells(i, "at") N.Range("f24") = DB.Cells(i, "bc") N.Range("f25") = DB.Cells(i, "bl") N.Range("f26") = DB.Cells(i, "bt") N.Range("f27") = DB.Cells(i, "cb") N.Range("c31") = DB.Cells(i, "cl") N.Range("g31") = DB.Cells(i, "cm") End Sub وأنصح دائما بدراسة وفهم الكود ومتغيراته وكائناته جيدا قبل تطبيقه على شيت آخر
بالتوفيق
طباعة فردي أو جماعي.xlsm

إذا كان الهدف اختصار الكود
فجرب هذا
تم تحويل النطاق من range إلى cells للتحكم في رقم العمود بدلا من الحرف الخاص به
Sub mySort() For c = 2 To 48 Step 2 Range(Cells(5, c), Cells(Cells(Rows.Count, c).End(xlUp).Row, c)).Sort Key1:=Cells(5, c), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal Next c MsgBox "Done by mr-mas.com" End Sub بالتوفيق

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

المشكلة في الخروج من الاجراء قبل تكملة تنفيذ الكود
If lasts > 0 Then MsgBox "هذا الإسم موجود بالفعل", vbCritical, "تنبيه" End If Exit Sub والصواب
If lasts > 0 Then MsgBox "هذا الإسم موجود بالفعل", vbCritical, "تنبيه" Exit Sub End If ولا ادري ما السبب في استعمال كود غريب لجلب آخر صف مكتوب فيه
iRow
الطبيعي استعمال 
end(xlup). row
بالتوفيق

تمكين المحتوى هو الزر الأصفر الذي يظهر في بداية فتح ملف يحتوي على أكواد في حالة ارتفاع نسبة الأمان في برنامج الاكسل
أما عن تنفيذ الكود في الشيت المحمي
ففي هذه الحالة يجب وضع كود فك حماية الشيت في أول سطر في الكود بعد اسم الاجراء sub name
ActiveSheet.UnProtect "password" ووضع كود وضع الحماية في آخر سطر في الكود قبل end sub
ActiveSheet.Protect "password" مع كتابة كلمة المرور بدلا من كلمة password
بالتوفيق

يمكنك استعمال هذه المعادلة في الخلية B9
للحصول على المطلوب الأول
=IF(SUMPRODUCT(IF($B$1:$B$4=TRUE,1,0),TRANSPOSE(INDEX(Data!$C$2:$F$11,MATCH(B8,Data!$B$2:$B$11,0),{1,2,3,4})))=SUM(IF($B$1:$B$4=TRUE,1,0)),"","غير ")&"مناسب" وبالنسبة للمطلوب الثاني
يمكن الوصول لجميع أفراد المجموعة التي منها هذا الاسم ومعرفة ومن منهم مناسب ومن منهم غير مناسب
في الخلايا D1:I7 ويمكن سحب المعادلة في العمود D & E لأسفل إذا زاد عدد المجموعة
وهذا لاختيار البديل يدويا
كما في الملف المرفق
بالتوفيق
 
المناسب للهوايات المختارة.xlsx

جرب هذا المرفق
يمكنك اختيار اسم الورقة وحالة السداد حسب ما يتم كتابته في عمود حالة السداد
تمت التجربة بكتابة 1 أو 0 في عمود حالة السداد W
فقط يلزمك تغيير أرقام الأعمدة المطلوب الحصول عليها بين القوسين {3,5,6,8}
بالتوفيق
جلب بيانات من الصفوف حسب حالة السداد.xlsx

يمكنك تجربة هذا الملف
تم جلب أول 3 أسماء في العمود A ووضعها في العمود D
وكذلك أول 3 أسماء في العمود C ووضعها في العمود E
واستعمال معادلة العد بشرط
=COUNTIF(E:E,D2)>0 لاستعمالها في تلوين خلايا العمود D عن طريق التنسيق الشرطي
بالتوفيق
 
مقارنة أول 3 أسماء.xlsb

بعد إذن الجميع
هذا ملفك بعد تصحيح الخطأ في الكود
الخطأ في نقل الكود وليس الكود الأصلي
وينتج هذا الخطأ عن عدم فهم دلالات الأرقام والمتغيرات في الكود
بالتوفيق
مجمع الشيتات.xlsm