عبدالله المجرب

على حد فهمي جرب هذه المعادلة =SUM(SUM(ABS(F9);ABS(F12);ABS(F14);ABS(F15);ABS(F16);ABS(F17));-SUM(ABS(F10);ABS(F11);ABS(F13);ABS(F18);ABS(F19)))

اخي الكريم ما مصدر القائمة المنسدلة في ComboBox1

جرب اعادة تثبيت الأوفيس

اتقدم بالاصالة عن نفسي ونيابة عن جميع الاعضاء بالتهنئة الى الاخوين الفاضلين: 1. الخالدي بمناسبة ترقيته الى خبير معتمد 2. رجب جاويش بمناسبة ترقيته الى عضو فعال وان شاء الله نرى فيهما النشاط المعهود دائماً === سينقل الموضوع الى المنتدى الاجتماعي بعد فترة

اضف هذا السطر في بداية الكود [B6:F27].ClearContents

هذا بالنسبة للمطلب الاول Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, [A6:L24]) Is Nothing Then [B3].Value = Cells(Target.Row, 3).Value End If If Not Intersect(Target, [F6:L24]) Is Nothing Then [C3].Value = Target.Value End If End Sub ============= بخصوص الصورة راجع هذا الموضوع http://www.officena.net/ib/index.php?showtopic=40613

السلام عليكم هذا الكود خلاصة عدد كبير من المحاولات والجهد جربه ان شاء الله يكون ما طلبت للعلم اذا بلغ عدد مجموع تكرار اي اسم اكبر من 21 (عدد الخانات المتاحة للتوزيع ) سيتم ايقاف التوزيع وظهور رسالة تنبهك بالاسم المتجاوز 22222222.rar

اخي عمر انا جربت الكود ويعمل زي الفل (تاكد من امان الماكرو)

السلام عليكم بعد البحث وجدت الموضوع http://www.officena.net/ib/index.php?showtopic=40899 ان شاء الله ان توفر لي الوقت ساشرحه

ارفق الملف الذي به اكود ليسهل تتبعه وشرحه

جرب هذا الكود لحذف التكرار Sub Abu_Ahmed() For i = 19 To 2 Step -1 If Application.CountIf([B2:B19], Cells(i, 2)) > 1 Then Cells(i, 2).Delete Shift:=xlUp Next End Sub

راجع هذا الموضوع http://www.officena.net/ib/index.php?showtopic=29357 او ابحث عن تفقيط انجليزي

السلام عليكم جرب المرفق (حسب فهمي) فرز.zip

السلام عليكم ليس هناك فرق ولكني متعود على استخدام And بحكم ان الشروط اكثر في ملفاتي

السلام عليكم جرب المرفق book99.rar

السلام عليكم اليك المرفق بعد التعديل 12 2011 MANPOWER LIST - ned.rar

السلام عليكم جرب المرفق البحث عن اكثر من بيان.rar

السلام عليكم بعد اذن اخي رجب هذا الكود يوضع في حدث الورقة ولن تحتاج لزر أمر Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 2 Then Exit Sub If Not Intersect(Target, [A2:B100]) Is Nothing Then Cells(Target.Row, 3) = Empty If Target.Value = Empty Then Cells(Target.Row, 3) = "": Exit Sub If Val(Cells(Target.Row, 2)) = 0 Then Cells(Target.Row, 3) = "لا يمكن القسمة على صفر": Exit Sub Cells(Target.Row, 3) = Val(Cells(Target.Row, 1)) / Val(Cells(Target.Row, 2)) End If End Sub

السلام عليكم اخي فضل جرب المرفق (نسبة التكرار تمثل حالة كل 8 مرات تقريباً) حسب التجربة كود يمنع تكرار رقم فى نفس السطر مرتين المايسترو.rar

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

ضع هذا الكود في حدث الصفحة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 2 Then Exit Sub If Target.Value = Empty Then Range(Cells(Target.Row, 4), Cells(Target.Row, 24)) = Empty: Exit Sub If Not Intersect(Target, [C2:C50]) Is Nothing Then Range(Cells(Target.Row, 4), Cells(Target.Row, 24)) = Empty Range(Cells(Target.Row, 4), Cells(Target.Row, 3 + Val(Target))) = Target.Offset(0, -1) End If End Sub

حياك الله اخي الفاضل

السلام عليكم الاستاذ الفاضل بن عليه حل جميل سلمت يمينك (اما تتبعني واما اتبعك) الاخ رجب معادلة رائعة (ان شاء الله نراك متفاعلاً دوماً) === اخي ابو تميم هذا حل بالكود وبه ميزة معادلة الاخ رجب Sub Abu_Ahmed_Max() For i = 6 To [b1000].End(xlUp).Row w = Mid(Cells(i, 2), 1, InStr(Cells(i, 2), "-")) ww = Val(Mid(Cells(i, 2), InStr(Cells(i, 2), "-") + 1, 6)) If ww > k Then k = ww: R = w Next [d6] = R & k End Sub

المطلوب غير واضح حبذا لو تضع في المرفق النتجة المطلوبة ليتم تنفيذها

احسنت ولو تلاحظ ان ناتج التاريخ يكون 02:03:2012 رغم ان الكود صيغة التاريخ بنسق dd/mm/yyyy ويعود ذلك الى تنسيق الخلايا لو تلاحظ