طارق محمود

السلام عليكم أخي العزيز ضع هذا الكود للفورم المذكورة Private Sub CommandButton1_Click() If CheckBox13.Value = True Then For i = 0 To 11: Controls(i).Value = True: Next For i = 0 To 11 If Controls(i).Value = True Then a = Controls(i).Caption & ".xls": open_a (a) Next Me.Hide End Sub Function open_a(a) pt = ActiveWorkbook.Path & "\" nm = ActiveWorkbook.Name mfile = pt & a Workbooks.Open mfile sr = Array(5, 42, 78, 114, 150) er = Array(34, 71, 107, 143, 173) For i = 0 To 4 Sheets("total1").Range("D" & sr(i) & ":G" & er(i)).Copy Workbooks(nm).Sheets("total1").Range("D" & sr(i) & ":G" & er(i)).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd Sheets("total1").Range("I" & sr(i) & ":K" & er(i)).Copy Workbooks(nm).Sheets("total1").Range("I" & sr(i) & ":K" & er(i)).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd Sheets("total2").Range("D" & sr(i) & ":H" & er(i)).Copy Workbooks(nm).Sheets("total2").Range("D" & sr(i) & ":H" & er(i)).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd Sheets("total2").Range("K" & sr(i) & ":K" & er(i)).Copy Workbooks(nm).Sheets("total2").Range("K" & sr(i) & ":K" & er(i)).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd Next ActiveWorkbook.Close End Function Private Sub UserForm_Activate() For i = 0 To 12 Controls(i).Value = False Next i sr = Array(5, 42, 78, 114, 150) er = Array(34, 71, 107, 143, 173) For i = 0 To 4 Sheets("total1").Range("D" & sr(i) & ":G" & er(i)).ClearContents Sheets("total1").Range("I" & sr(i) & ":K" & er(i)).ClearContents Sheets("total2").Range("D" & sr(i) & ":H" & er(i)).ClearContents Sheets("total2").Range("K" & sr(i) & ":K" & er(i)).ClearContents Next i End Sub أو تفضل المرفق وبه الفورم وقد وضعت بعض البيانات الافتراضية بالملفين يناير وأغسطس للتجربة فقط البرنامج 111.rar

جزاك الله خيرا ولك مثل مادعوت وأكثر إن شاء الله

السلام عليكم بالنسبة لترحيل خانة الملاحظات ايضا مع ترحيل البيانات فى شيت اجمالى العملاء ، تفضل المطلوب في المرفق نعم : عند التعامل مع ماركة جديده لابد من اضافة ثلاث اعمدة لها عن طريق نسخ أي ثلاث أعمدة بمعادلاتهم من الموجود ، ثم تغيير إسم الماركة فقط ولايلزم أي تعديل للكود ، حيث جزء الأعمدة بالمعادلات فقط ولكن لابد من نفس الشكل أي أن الماركة تكون مكتوبة في السطر الثاني ويتم نسخ المعادلات المكتوبة بالفونط الأبيض في السطر الأول تلقائيا مع النسخ وكذلك معادلات الخلايا داخل الأعمدة ، بلاتغيير ، فقط إنسخ الأعمدة من صنف سابق إنتبهت ان الملف به كود لأخي الحبيب الغالي / رجب جاويش لكن لاتعارض بين الأكواد لن تهمنا في حالة أنني أضفت كافة الأنواع لجميع العملاء فقط يتعين ألا يزيد إجمالي عدد كافة الأنواع لجميع العملاء عن 82 حيث أن صيغة xls التي تستخدمها محدودة في عدد الأعمدة أما إذا كان لديك أوفيس 2007 أو مافوقه فيمكنك زيادة عدد الأنواع ادخال شيت دخول مع شيت خروج لعمل شيت اجمالى عملاء4.rar

أخي العزيز اتبع الخطوات في الصورة

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

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

السلام عليكم أخي العزيز تم إضافة أعمدة جديدة بجميع الانواع (3 أعمدة لكل ماركه) لاحظ أنها مخفية، تستطيع إظهارها الآن باختيار العميل فى الخانة J1 يتم الآتي •مسح البيانات القديمة A4:G800 للعميل السابق •استدعاء بيانات العميل (عن طريق فلتر للصفحة المقصوده) من شيت دخول جبنة ثلاجة بما فيها خانة الملاحظات وكذلك من شيت خروج ثلاجة بما فيها خانة الملاحظات •ثم ترتيب البيانات كلها حسب التاريخ •تضبيط المعادلة في العمود F •يتم (بالمعادلات) نقل الكمبات لأعمدة الماركة الخاصة بها فى اى من الخانتين دخول او خروج •يتم بالكود إخفاء أوتوماتيكي لأعمدة الماركات التي ليس بها بيانات لم أفهم ماالذي تريد اضافته فى اجمالى العملاء تفضل المرفق ادخال شيت دخول مع شيت خروج لعمل شيت اجمالى عملاء3.rar

السلام عليكم شرح الكود في الصورة المرفقة

السلام عليكم تفضل المرفق ادخال شيت دخول مع شيت خروج لعمل شيت اجمالى عملاء2.rar

السلام عليكم أخي العزيز تفضل هذا هو الكود Sub add_new_sheet() d = DateValue(ActiveSheet.Name) + 1 new_name = Format(d, "dd-mm-yyyy") ActiveSheet.Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = new_name [c8] = "'" & new_name For Each ce In [G25:V36] If ce.HasFormula = True Then GoTo 10 ce.ClearContents 10 Next End Sub وهذا الملف مرفق وبه الكود يعمل بالزر الأحمر لاحظ أنني أضفت الحلقة التالية بنهاية الكود For Each ce In [G25:V36] If ce.HasFormula = True Then GoTo 10 ce.ClearContents 10 Next وهي تقوم بمسح البيانات (وليس المعادلات) الموجودة بالنطاق G25:V36 rapport journalier GO Préfas.rar

تفضل المرفق ex2.rar

السلام عليكم تفضل المرفق tekrar_2.rar

السلام عليكم أخي الكريم جرب هذا الكود Sub ConvertFunction() Dim H, B, C, J, K, M As Range With Sheet1 Set H = .Range("H:H"): Set B = .Range("B:B") Set C = .Range("C:C"): Set J = .Range("J:J") Set K = .Range("K:K"): Set M = .Range("M:M") End With LR = [B65536].End(xlUp).Row If LR <= 5 Then MsgBox "No data to retreive": Exit Sub For r = 5 To LR cl = Cells(r, 2) cr1 = ">=" & [C1]: cr2 = "<=" & [C2] cr3 = ">=" & [G1]: cr4 = "<=" & [G2] Cells(r, 3) = WorksheetFunction.SumIfs(H, B, cl, C, cr1, C, cr2) Cells(r, 4) = WorksheetFunction.SumIfs(J, B, cl, C, cr1, C, cr2) Cells(r, 6) = WorksheetFunction.SumIfs(K, B, cl, C, cr1, C, cr3) Cells(r, 7) = WorksheetFunction.SumIfs(M, B, cl, C, cr1, C, cr4) Next End Sub تفضل المرفق وبه الكود 11_New.rar

السلام عليكم أخي العزيز / قنديل لاداعي أبدا للأسف بل العكس صحيح ، من دواعي سروري أن أجد آخرين يشاركون في نفس الموضوع ربما كان حلك أو شرحك أقرب لعقل او قلب السائل جزاك الله خيرا أخي السائل (m_ken0177) الحمد لله دمتم في خير

السلام عليكم أخي الكريم إستخدم المعادلة =LEFT(C2,4) في الخلية A2 ثم إنسخها للأسفل

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

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

السلام عليكم هذا خطأي فانا لم أراجع المعادلة الأصلية غير المعادلة في الخلية E2 إلي التالي =IF(ISERROR(VLOOKUP(A2,الموافقة!$A$2:$H$999,8,0)),"(غير معتمد)","معتمد :" & VLOOKUP(A2,الموافقة!$A$2:$H$999,8,0)) ثم إمسح السهم الأسود (بجوار اعادة صياغة المعادلة) ، لاداعي له الآن ثم إنسخ المعادلة لباقي الصفوف تفضل الملف معدلا جدول بحث3.rar

السلام عليكم أخي الكريم تم عمل المطلوب مع إضافة تنسيق شرطي يجعل لون الخلية يتغير أوتوماتيك في حال إن كانت النتيجة : (غير معتمد) تفضل المرفق جدول بحث2.rar

ضع المعادلة التالية في الخلية F2 من الورقة Target =OFFSET(Source!$A$1,MATCH(A2,Source!A:A,0)-1,MATCH(E2,Source!$1:$1,)-1) ثم انسخها للأسفل

السلام عليكم أخي الكريم لابد من التوضيح (1) مامعني عناوين الأعمدة في الورقتين Q. , A. , C 2 , 5 , 21 , 101 , 111 (2) ماذا تريد تحديدا إذا أخذنا اول عنصر (Code 10038) كمثال

مرفق الملف وبه المعادلة وبه أيضا تنسيق شرطي لمعرفة الغير مطابق أو الغير موجود باللون الأحمر مثال لمطابقة بين بين شريط الحاسبة والموافقة الأمنية2.rar

السلام عليكم أخي العزيز أعتقد أنني فهمت ولكن لابد من توضيح التالي تقول في الشرح أن السيارة 77777 (برج المعالي) والموجودة في الصف 12 من عمود شريط الحاسبة ، تقول أن الحالة ( غير مطابق) مع انها موجودة في السطر 14 بالموافقة الأمنية إذا كان هذا خطأ وإذا كان معني (غير مطابق) أن الرقم موجود ولكن اسم الشركة فجرب المعادلة التالية في الخلية C3 وانسخها لباقي الخلايا =IF(ISNUMBER(MATCH(D3,$A$3:$A$966,0)),IF(E3=OFFSET($B$2,MATCH(D3,$A$3:$A$966,0),0),"مطابق","غير مطابق"),"غير موجود") مع مراعاة أن تستبدل الفاصلة بفاصلة منقوطة إن كان نظام الجهاز عندك كذلك

في عمود آخر إستخدم الدالة LEN وهي ستعد طول الأرقام (أو الحروف) ثم فلتر (تصفية) بناءا علي هذا العمود الجديد

السلام عليكم المرفق به 3 صور توضيحية تفضل New Microsoft Excel Worksheet.rar