طارق محمود

السلام عليكم أخي الكريم لم أفهم بعد إرسل الملف وبه ماتريد إشرح بدقة المطلوب

تفضل أخي الفيديو المرفق تري انني (1) غيرت التاريخ ليكون (من 19/11/2011 إلى 18/12/2011 ) (2) زودت أيام حضور أحد العاملين إلى 26 بل 27 leprince2007.rar

لا أخي العزيز طبعا أنت تعرف أن التغيير لايكون في المعادلات ولكن في الخلية الرئيسية H1 والتي سوف تغير تبعا في المعادلات أنا جربت نفس الفرض وأنتجت المعادلات الشهر 30 والجمعه 4 راجع مود الحسابات لديك (غالبا ليس أوتوماتيك) لتتغيره File Options Formulas Calculation Options أول خيار Automatic

السلام عليكم عارف إنك بتحب المعادلات تفضل Extra_Req_TAREQ.rar

السلام عليكم لاأدري ، قد يكون الأنسب الأكسس وإن كنت فهمت ضمنيا انه من الممكن ضم معظم أو كل الملفات في ملف واحد إكسل (الملف الإكسل الواحد يمكن عمل عدد من الورقات به يزيد عن الألف حسب ما أعلم) حاول ترسل الملفات بعد تقليص البيانات إلي أقصي ماتستطيع ثم ضغط المجلد الذي به الملفات

عفوا الصح من نظام الويندوز إذا كان XP من كنترول بانل Control Panel Regional and Language Options Regional Options Customize List Seprator

السلام عليكم أهلا ومرحبا بك اخي بين إخوانك عضوا نافعا منتفعا غن شاء الله هذه الفاصلة أو المنقوطة من إعدادات الإكسل اخبرني أي أوفيس تستخدم 2003 -2007 -2010 حتي أدلك علي ضبطها كما تحب

السلام عليكم أخي العزيز المعادلة متصلة ببيانات في الورقة الأولي (مبيعات الفرع) والورقة الأولي متصلة ببيانات في جهازك لملف E:\[بدايه المشروع.xlsx] لذلك تعطي الورقة الأولي كلها أخطاء ثم لماذا ترسل كل هذه البيانات يكفي 10 او 20 سطر للمسألة والحل وليس 2500 سطر مما يجعل التحميل صعب علي من يريد المساعدة وسرعة الإنترنت ضعيفة عنده عموما إرسل الملف الآخر ليسهل علي من يريد تتبع المعادلة

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

السلام عليكم أخي العزيز ورقة ارقام الجلوس بها أسهم تحكم والموجودة تقريبا عند الخلايا W2:W4 وهي تتحكم وتغير فقط الخلايا C53 - C39 - C24 - C9 لتأخذ 4 أرقام جلوس متتالية ثم تأتي بقية البيانات (مثل الإسم و الفصل الدراسى و الصف ورقم اللجنة و مكان اللجنة) تأتي هذه البيانات عن طريق دوال ومعادلات من الورقة الأصلية (الاسماء) لذلك إجابة لسؤالك يمكنك التعديل على ورقة ارقام الجلوس بطريق غير مباشر بالتعديل في الورقة الأصلية (الاسماء)

السلام عليكم أخي العزيز راجع اولا الروابط التالية غالبا ستجد ماتريد وزيادة وإلا تحدد أكثر السؤال بعدما تطلع علي تلك المواضيع تفضل روابط المواضيع http://www.officena.net/ib/index.php?showtopic=15955&hl=%2B%D8%A7%D9%84%D9%88%D8%A7%D8%B1%D8%AF+%2B%D8%A7%D9%88%D9%84%D8%A7+%2B%D9%8A%D8%B5%D8%B1%D9%81+%2B%D8%A7%D9%88%D9%84%D8%A7&fromsearch=1 http://www.officena.net/ib/index.php?showtopic=34326&hl=%2B%D8%A7%D9%84%D9%88%D8%A7%D8%B1%D8%AF+%2B%D8%A7%D9%88%D9%84%D8%A7+%2B%D9%8A%D8%B5%D8%B1%D9%81+%2B%D8%A7%D9%88%D9%84%D8%A7&fromsearch=1 http://www.officena.net/ib/index.php?showtopic=36037&st=0&p=191141&#entry191141

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

السلام عليكم تفضل أخي الملف مرة اخري وبه ورقة لشرح الكود بالتفصيل رياضيات 4.ب_TAREQ.rar

السلام عليكم أخي الفاضل تفضل المرفق به ماطلبت رياضيات 4.ب_TAREQ.rar

السلام عليكم أخي العزيز قام مشكورا الأخ الغالي والأستاذ الفاضل / أحمد زمان برفع الملف إلي مشاركتي السابقة (#8) ولم تعلق هل هذا ماتريد؟

السلام عليكم الكود التالي بعد التعديلات يقوم بعمل حد أدني للإختيار 4 قضبان وحد أعلي للإختيار 12 قضيب وكذلك الأقطار تبدأ من 12 تفضل الكود Private Sub Worksheet_Calculate() Application.ScreenUpdating = False Dim dia(99), d As Integer, A(99, 99) As Double i = 0 For d = 12 To 40 Step 2 If d = 26 Or d = 34 Or d = 36 Or d = 38 Then GoTo 10 If d = 24 Then i = i + 1: dia(i) = 25: GoTo 10 i = i + 1 dia(i) = d 10 Next d For q = 1 To 12 For i = 1 To 11 A(q, i) = Round(q * dia(i) ^ 2 / 400 * WorksheetFunction.Pi, 2) Next i Next q A_min = 2 * [S4] / 100 For q = 2 To 12 Step 2 For i = 1 To 11 For qq = 2 To 12 Step 2 For ii = 1 To 11 If ii = i Then GoTo 20 If (A(q, i) + A(qq, ii)) < [S4] / 100 Then GoTo 20 If Abs(i - ii) > 2 Then GoTo 20 If (A(q, i) + A(qq, ii)) > 1.5 * [S4] / 100 Then GoTo 20 If (A(q, i) + A(qq, ii)) < A_min And (q + qq) > 3 And (q + qq) < 12 Then A_min = A(q, i) + A(qq, ii) Chosn = q & "f" & dia(i) & " + " & qq & "f" & dia(ii) & " = " & A_min q1 = q: d1 = dia(i): q2 = qq: d2 = dia(ii) End If 20 Next ii Next qq Next i Next q For q = 2 To 12 Step 2 For i = 1 To 11 If A(q, i) < [S4] / 100 Then GoTo 30 If A(q, i) > 1.5 * [S4] / 100 Then GoTo 30 If A(q, i) < A_min And q > 3 And q < 12 Then A_min = A(q, i) + A(qq, ii) Chosn = q & "f" & dia(i) & " = " & A_min q1 = q: d1 = dia(i): q2 = 0: d2 = 0 End If 30 Next i Next q [S6] = Chosn [E5:P16].Interior.ColorIndex = xlNone cc1 = WorksheetFunction.Match(q1, [E4:P4], 0) rr1 = WorksheetFunction.Match(d1, [Q5:Q16], 0) Cells(rr1 + 4, cc1 + 4).Interior.ColorIndex = 3 If q2 = 0 Then GoTo 55 cc2 = WorksheetFunction.Match(q2, [E4:P4], 0) rr2 = WorksheetFunction.Match(d2, [Q5:Q16], 0) Cells(rr2 + 4, cc2 + 4).Interior.ColorIndex = 3 55 Application.ScreenUpdating = True End Sub

السلام عليكم أخي العزيز تقول وجدت بعض الأشياء البسيطة عدلتها لك ستجدها بالأحمر ولون الخلية أصفر في شييت المطلوب: الخلية C51 كان بها الوظيفة عامل وغيرته لـ فنى في شييت Data_Entry: خلية أخري كان بها عمالة فنية وغيرتها لـ عمالة عادية تفضل المرفق attendance_TAREQ.rar

السلام عليكم أخي العزيز فقط اضف السطر التالي في حلقة الإختيار If Abs(i - ii) > 2 Then GoTo 20 ليكون الكود في النهاية هكذا Private Sub Worksheet_Calculate() Application.ScreenUpdating = False Dim dia(99), d As Integer, A(99, 99) As Double i = 0 For d = 10 To 40 Step 2 If d = 26 Or d = 34 Or d = 36 Or d = 38 Then GoTo 10 If d = 24 Then i = i + 1: dia(i) = 25: GoTo 10 i = i + 1 dia(i) = d 10 Next d For q = 2 To 12 For i = 1 To 12 A(q, i) = Round(q * dia(i) ^ 2 / 400 * WorksheetFunction.Pi, 2) Next i Next q A_min = 2 * [S4] / 100 For q = 2 To 12 Step 2 For i = 1 To 12 For qq = 2 To 12 Step 2 For ii = 1 To 12 If ii = i Then GoTo 20 If (A(q, i) + A(qq, ii)) < [S4] / 100 Then GoTo 20 If Abs(i - ii) > 2 Then GoTo 20' هذا هو السطر المضاف If (A(q, i) + A(qq, ii)) > 1.5 * [S4] / 100 Then GoTo 20 If (A(q, i) + A(qq, ii)) < A_min Then A_min = A(q, i) + A(qq, ii) Chosn = q & "f" & dia(i) & " + " & qq & "f" & dia(ii) & " = " & A_min q1 = q: d1 = dia(i): q2 = qq: d2 = dia(ii) End If 20 Next ii Next qq Next i Next q For q = 2 To 12 Step 2 For i = 1 To 12 If A(q, i) < [S4] / 100 Then GoTo 30 If A(q, i) > 1.5 * [S4] / 100 Then GoTo 30 If A(q, i) < A_min Then A_min = A(q, i) + A(qq, ii) Chosn = q & "f" & dia(i) & " = " & A_min q1 = q: d1 = dia(i): q2 = 0: d2 = 0 End If 30 Next i Next q [S6] = Chosn [E5:P16].Interior.ColorIndex = xlNone cc1 = WorksheetFunction.Match(q1, [E4:P4], 0) rr1 = WorksheetFunction.Match(d1, [Q5:Q16], 0) Cells(rr1 + 4, cc1 + 4).Interior.ColorIndex = 3 If q2 = 0 Then GoTo 55 cc2 = WorksheetFunction.Match(q2, [E4:P4], 0) rr2 = WorksheetFunction.Match(d2, [Q5:Q16], 0) Cells(rr2 + 4, cc2 + 4).Interior.ColorIndex = 3 55 Application.ScreenUpdating = True End Sub

السلام عليكم تفضل المرفق وبه المطلوب وبه أيضا تعديل طفيف في العمود المساعد Helping Column ليتعرف أوتوماتيك علي نصف الشهر (الأول أو الثاني) وكذلك ألغيت عمود الشهور ، حيث يوجد خاصية بالجداول المحورية pivot tables تستطيع من خلالها تجميع البيانات (شهري - سنوي - أو أي من الخيارات الموجودة) المرفق علي الرابط ==== تم إضافة المرفق الى المشاركة suppliers required_3Tareq.rar

السلام عليكم بريدي موجود علي صفحتي tarekmahmoud_2@hotmail.com

ياأخي والله أنا لاأفهم إيه اللي يزعجك في الـ pivot table إذا كان بس موضوع التحديث فمن الممكن التغلب عليه ببساطة كود من سطرين يحدث الورقة التي بها الـ pivot table أوتوماتيكيا

السلام عليكم مازال الملف ليس بالكمال المطلوب أعلم أن الأفضل أن تكون الأقطار متقاربة فلايجوز مثلا ان تستخدم قطر 12 ، 20 الأفضل أن يكون فارق درجة واحدة أو إثنين علي الأكثر ولكن إلي السبت القادم إن شاء الله

السلام عليكم ممكن تجعل الخطوة ثنائية في حلقة عداد الكميات بإضافة جملة Step 2 لآخر كل سطر يبدأ بـ For q أو For qq وسيكون الكود النهائي هكذا Private Sub Worksheet_Calculate() Application.ScreenUpdating = False Dim dia(99), d As Integer, A(99, 99) As Double i = 0 For d = 10 To 40 Step 2 If d = 26 Or d = 34 Or d = 36 Or d = 38 Then GoTo 10 If d = 24 Then i = i + 1: dia(i) = 25: GoTo 10 i = i + 1 dia(i) = d 10 Next d For q = 2 To 12 For i = 1 To 12 A(q, i) = Round(q * dia(i) ^ 2 / 400 * WorksheetFunction.Pi, 2) 'Cells((q - 1) * 12 + i, "V") = "A(" & q & "dia-" & dia(i) & ")" 'Cells((q - 1) * 12 + i, "W") = A(q, i) Next i Next q A_min = 2 * [S4] / 100 For q = 2 To 12 Step 2 For i = 1 To 12 For qq = 2 To 12 Step 2 For ii = 1 To 12 If ii = i Then GoTo 20 If (A(q, i) + A(qq, ii)) < [S4] / 100 Then GoTo 20 If (A(q, i) + A(qq, ii)) > 1.5 * [S4] / 100 Then GoTo 20 If (A(q, i) + A(qq, ii)) < A_min Then A_min = A(q, i) + A(qq, ii) Chosn = q & "f" & dia(i) & " + " & qq & "f" & dia(ii) & " = " & A_min q1 = q: d1 = dia(i): q2 = qq: d2 = dia(ii) End If 20 Next ii Next qq Next i Next q For q = 2 To 12 Step 2 For i = 1 To 12 If A(q, i) < [S4] / 100 Then GoTo 30 If A(q, i) > 1.5 * [S4] / 100 Then GoTo 30 If A(q, i) < A_min Then A_min = A(q, i) + A(qq, ii) Chosn = q & "f" & dia(i) & " = " & A_min q1 = q: d1 = dia(i): q2 = 0: d2 = 0 End If 30 Next i Next q [S6] = Chosn [E5:P16].Interior.ColorIndex = xlNone cc1 = WorksheetFunction.Match(q1, [E4:P4], 0) rr1 = WorksheetFunction.Match(d1, [Q5:Q16], 0) Cells(rr1 + 4, cc1 + 4).Interior.ColorIndex = 3 If q2 = 0 Then GoTo 55 cc2 = WorksheetFunction.Match(q2, [E4:P4], 0) rr2 = WorksheetFunction.Match(d2, [Q5:Q16], 0) Cells(rr2 + 4, cc2 + 4).Interior.ColorIndex = 3 55 Application.ScreenUpdating = True End Sub

السلام عليكم المرفق بالمعادلات وبه كود يأتي فقط بالموردين والخامات وقد أضفت تنسيق شرطي لتلك الأعمدة الثلاثة الخاصة بالموردين والخامات تجعل البيانات المكررة ضعيفة اللون وأضفت أيضا للتاريخ (السطر 4) معادلة لحساب أول وآخر نصف الشهر أوتوماتيكيا فقد كان هناك بعض أخطاء في النصف الثاني من الشهور التي ليست 30 يوم (1،2،3،5،7،8،10،12) تفضل المرفق إضغط الزر الأصفر (جلب أسماء الموردين والمواد) suppliers required_2Tareq.rar

والآن وقد رددت علي النقطة الثالثة وردا علي النقطتين الأولي والثانية عدل الكود الخاص بالترحيل لورقة Statement of Account ليكون كالتالي Sub Shift_2_Stament() Sheets("J.V").Select '================================================================== With Sheet5 'Statement of Account ترحيل إلي الصفحة ' أول سطر بيانات في هذه الورقة 9 وليس 4 كالسابقات LastRow = .Cells(1000, 4).End(xlUp).Row + 1 If LastRow < 9 Then LastRow = 9 '=========================================== Trg_AC = .[D6] For R = 7 To 43 deb = Cells(R, 3): crd = Cells(R, 4): Acnt = Cells(R, 5).Value If deb = "" And crd = "" Then GoTo 50 If Cells(R, "E") <> Trg_AC Then GoTo 50 If crd = "" Then .Cells(LastRow, 2) = .Cells(LastRow, 2) + deb Else .Cells(LastRow, 3) = .Cells(LastRow, 3) + crd End If .Cells(LastRow, "H") = [b2] .Cells(LastRow, "G") = [b3] .Cells(LastRow, "F") = [b4] .Cells(LastRow, "D") = [E44] LastRow = LastRow + 1 50 Next R End With End Sub مرفق صورة وبها الجانب اليسار من ورقة J.V قبل إجراء الكود الجانب اليسار من ورقة Statement of Account بعد إجراء الكود