عبدالله باقشير

السلام عليكم شاهد المرفق 2003 Shipment Tracking New Version12.rar

المرفق 2003 1- تعديل كود اضافة الاوراق الى كود جديد يضيف الاوراق بدون مشاكل المعادلات المذكورة سابقا 2- اضافة كود جديد للمجاميع في وزرقة توتال Shipment Tracking New Version10_1.rar

وعليكم السلام المعادلتين خارجة عن نطاق الجدول ممكن تسجل كود بالمعادلتين وتضمنها مع الحدث او تربطها بزر هذا مثال: لاحدى المعادلتين Sub ماكرو1() Range("I12").FormulaR1C1 = _ "=SUMPRODUCT((الوكلاء!R5C5:R2002C5<=R8C5)*(الوكلاء!R5C4:R2002C4=R[-2]C[-4])*(الوكلاء!R5C8:R2002C8))" Range("I12").Value = Range("I12").Value End Sub

السلام عليكم بارك الله فيك اخي يحياوي ائراءا للموضوع: المرفق 2003 نسخ ورقة كعينة.rar

احسنت اخي الحبيب رجب حفظك الله احسنت اخي الحبيب محمود حفظك الله جزاكم الله خيرا تقبلوا تحياتي وشكري

اخي الشهابي احسنت بارك الله فيك

اكرمك الله اخي الحبيب محمد وجزاك خيرا وبارك فيك وحفظك من كل مكروه تقبل تحياتي وشكري

' للخصم Sub kh_SUM1() Dim R As Long For R = 12 To 26 If CStr(Cells(R, "D")) = CStr(Range("D4")) And CStr(Cells(R, "E")) = CStr(Range("E4")) Then Cells(R, "F").Value = Val(Cells(R, "F")) - Val(Range("F4")) End If Next End Sub ' للجمع Sub kh_SUM2() Dim R As Long For R = 12 To 26 If CStr(Cells(R, "D")) = CStr(Range("D8")) And CStr(Cells(R, "E")) = CStr(Range("E8")) Then Cells(R, "F").Value = Val(Cells(R, "F")) + Val(Range("F8")) End If Next End Sub

السلام عليكم على السريع بدوال بسيطة اخفي عمود دالة ماتش المرفق2007 ترتيب.rar

وعليكم السلام ' للخصم Sub kh_SUM1() Dim Cel As Range For Each Cel In Range("D12:D26") If CStr(Cel) = CStr(Range("D4")) Then Cel.Offset(0, 1).Value = Val(Cel.Offset(0, 1)) - Val(Range("E4")) End If Next End Sub ' للجمع Sub kh_SUM2() Dim Cel As Range For Each Cel In Range("D12:D26") If CStr(Cel) = CStr(Range("D8")) Then Cel.Offset(0, 1).Value = Val(Cel.Offset(0, 1)) + Val(Range("E8")) End If Next End Sub

وعليكم السلام ارفق الملف للتعديل عليه

اخي الحبيب ابو حنين عفوا فقط زيادة في الخير

السلام عليكم Sub kh_Test() Dim i As Integer ''''''''''''''''''' For i = 1 To 100 If Val(Cells(i, "A")) > Val(Cells(i, "B")) Then Cells(i, "B").Value = Cells(i, "A").Value End If ''''''''''''' If Val(Cells(i, "A")) < Val(Cells(i, "C")) Then Cells(i, "C").Value = Cells(i, "A").Value End If Next ''''''''''''''''''' End Sub

السلام عليكم العمل يعطي نتائج صحيحة بدون ان تقارن اما عن تفسير عبارة اخي الحبيب الخالدي عند احتواء خلايا العميل على معادلات هنا المقصود به العمود 1 الذي فيه اسماء العملاء اذا كانت هذه الاسماء تاتي عن طريق معادلة في هذه الحالة لن يعطيك نتائج صحيحة هذا جعله اخي الخالدي تنبيه لمن قد يستخدم الكود بمثل هذه الحالة وبالنسبة لكود الحذف برضه صحيح في حالة اضفت ورقة وتريدها باقية في الملف اضف اسمها في كود الحذف علشان يتجاوزها مثل ما اوردت انت في ردك الاخير If Sh.Name <> "Main" And Sh.Name <> "Totals" Then Sh.Delete او مثل الكود ادناه وبالنسبة لكود الخالدي للحذف فقط ياخذ نفس الاسماء التي اضيفت لاحقا بكود الانشاء من العمود 1 ====================================================== أيضاً عند الضغط على أنشاء صفحات للعملاء لمرة أخرى بعد أنشاءها لغرض تحديث البيانات أذا هنالك أدخالات جديدة في صفحة البيانات لا يحدث التحديث وأنما تحايلت عليه بطريقة أن أضفت كود حذف الصفحات قبل الكود كي تتم عملية التحديث أرجو حلها بطريقة أفضل. تم التعديل على كود الانشاء لعمل التحديث وايضا تعديل كود الحذف Option Explicit Sub kh_Delete_Worksheets() Dim ibt As Boolean Dim Sh As Worksheet On Error GoTo 1 Application.DisplayAlerts = False For Each Sh In ActiveWorkbook.Worksheets Select Case Sh.Name '''''''''''''''''''''''''''' 'هنا تضع اسماء الاوراق التي لا تريد حذفها Case "Main", "Totals" ''''''''''''''''''''''' Case Else: Sh.Delete End Select Next Sh 1: Application.DisplayAlerts = True End Sub وايضا تعديل في اكواد اخفاء واظهار الاعمدة Sub sHide() Dim Sh As Worksheet For Each Sh In ActiveWorkbook.Worksheets Select Case Sh.Name '''''''''''''''''''''''''''' Case "Main", "Totals" ''''''''''''''''''''''' Case Else Sh.Range("F1,K1:R1").EntireColumn.Hidden = True End Select Next End Sub Sub sUnHide() Dim Sh As Worksheet For Each Sh In ActiveWorkbook.Worksheets Select Case Sh.Name '''''''''''''''''''''''''''' Case "Main", "Totals" ''''''''''''''''''''''' Case Else Sh.Range("F1,K1:R1").EntireColumn.Hidden = False End Select Next End Sub المرفق 2003 Shipment Tracking New Version8_1.rar

جزاك الله خيرا

السلام عليكم هذه المعادلة تقوم بذلك =INDEX(TestRng;5^9-SUMPRODUCT(LARGE((INDEX(TestRng;0;2)>INDEX(TestRng;0;3))*5^9-ROW(TestRng);I11))-ROW(TestRng)+1;1) المرفق 2007 بارك الله فيكم.rar

السلام عليكم احسنت اخي الخالدي --------حفظك الله ملاحظتك في محلها تمام التمام جزاك الله خيرا وبارك فيك تقبل تحياتي وشكري

العفو اخي الفاضل

ارفق ملف في موضوع مستقل لتنفيذ طلبك ان شاء الله

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

السلام عليكم ممكن هذا حسب فهمي Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo 1 If Target.Address = Range("K3").Address Then Application.EnableEvents = False '''''''''''''''''''''''''' ' هنا تضع الامر الذي تريد تنفيده ''''''''''''''''''''''''''' With Target .Activate .ClearContents End With 1: Application.EnableEvents = True End If End Sub

السلام عليكم اخي سعد عابد---------------حفظه الله جزاك الله خيرا وبارك فيك تقبل تحياتي وشكري

السلام عليكم اخي يوسف --حفظه الله جزاك الله خيرا وبارك فيك تقبل تحياتي وشكري

السلام عليكم انا جربته على المرفق بدون معادلات في الخلايا انقل الفورم الى نسخة من ملفك الخاص تقريبا زر الحذف سيعطل المعادلات في الملف شاهد المرفق 2003-2007 طلب الشهابي.rar