علي السحيب

هل هذا ما تريد، _______________.rar

يتم إستخدام السلسلة للإستغناء عن عملية السحب المعروفة .. مثلاً لو أردت أن تكتب في العمود A الأعداد من 1 إلى 1000 .. فكيف تكتبها؟ بالطريقة التقليدية نكتب في الخلية الأولى الرقم 1 ثم في الخلية الثانية الرقم 2 .. ثم نقوم بتحديد الخليتين وسحب الخلية الثانية من طرفها السفلي إلى الأسفل حتى نصل إلى الصف الذي نريد. لإختصار هذه الخطوات كلها نستخدم الخاصية سلسلة وتكون الخطوات كالتالي: 1- نكتب أول رقم في الخلية الأولى ثم نقف عليها. 2- نذهب إلى القائمة تحرير ثم تعبئة ثم سلسلة. 3- نختار صف إذا أردنا أن تكون التعبئة بشكل أفقي ونختار عمود إذا أردناها بشكل عمودي. 3- نضع قيمة الخطوة المُراد زيادتها في كل خلية في المربع (قيمة خطوة). 4- نضع الرقم المُراد التوقف عنده في المربع (قيمة التوقف). ويوجد هناك خيارات أخرى أيضاً وأهمها خيار التاريخ وتفاصيله. أتمنى أن يكون الشرح واضح،

شاهد المرفق، _______________________________2.rar

الكود التالي ينفذ ما تريد: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 And Target.Row > 2 And Target.Row < 8 Then For R = 3 To 7 If Left(Cells(R, 2), 2) = 65 Then Cells(R, 7) = 20 Else: Cells(R, 7) = 14 End If Next End If End Sub شاهد المرفق، __________________________.rar

شاهد المرفق، _____________________.rar

أعتقد أن الطريقتين يعطيان نفس النتائج .. ولكن الدوال تختصر عليك الطريق .. وتجنبك الخطاً في إختيار الخلايا أو إدخال الأرقام.

كما ذكرت لك في ردي السابق .. رقم اللون مرتبط برقم الخلايا الست والخمسون الأولى من العمود الخامس E .. وستلاحظ في المرفق أنه تم تجاهل الأرقام التي بعد العدد 56 .. لأنه لا يوجد ألوان تقابلها. لن يتم إعطاء أي لون للرقم المكرر الذي يبلغ تسلسلة أكبر من 56. شاهد المرفق، _______________________________2.rar

ولمعلومات أكثر حول الدوال المُشار إليها في هذا الموضوع .. راجع الرابط التالي: http://www.officena.net/ib/index.php?showtopic=14235

عدد الألوان المتاحة في الإكسل هو 56 لون فقط .. وقد قمت في الكود بتحديد أول 15 لون منها .. وإذا قمنا بالتعديل اللازم على الكود سنغير الرقم 15 إلى الرقم 56 .. هذا أقصى ما نستطيع فعله.

أعتقد أن العنوان يكفي، _____________________________________.rar

شاهد المرفق، شاهد المرفق، IF_Function_in_VBA__2_.rar

الكود التالي ينفذ ما تريد وزيادة: Private Sub Worksheet_Change(ByVal Target As Range) TC = Target.Column TR = Target.Row If TC = 3 And TR > 1 And TR < 31 Then Set MyRange = [E2:E30] Set MyRange2 = [C2:C30] Application.ScreenUpdating = False With MyRange .ClearContents .Interior.ColorIndex = xlNone End With For C = 2 To 30 With Cells(C, 5) .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone End With Next For R = 2 To 30 If Application.WorksheetFunction.CountIf(MyRange2, Cells(R, 3)) > 1 Then With Columns(5).Rows(65536).End(xlUp) .Offset(1, 0) = Cells(R, 3) End With End If Next For Each Cell In MyRange If Application.WorksheetFunction.CountIf(MyRange, Cell) > 1 Then Cell.ClearContents End If Next MyRange.Sort [E2], xlAscending For R = 2 To 30 If Cells(R, 3).Row Mod 2 = 0 Then Cells(R, 3).Interior.ColorIndex = 35 If Cells(R, 3).Row Mod 2 = 1 Then Cells(R, 3).Interior.ColorIndex = 37 Next For C = 1 To 15 For Each Cell In MyRange2 If Cell = Cells(C, 5) And Cells(C, 5) <> "" Then Cell.Interior.ColorIndex = C Cells(C, 5).Interior.ColorIndex = C With Cells(C, 5) .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous End With End If Next Next Application.ScreenUpdating = True End If End Sub شاهد المرفق، ________________.rar

ومن قال لك أنه لم يجري أي تعديل على الكود!!! راجع كود البحث العام وستلاحظ بعض الإضافات عليه،

نعم أخي تامر تخرج لدي نفس الرسالة وعند الضغط على Debug .. يتم تضليل السطر التالي: Sheets(Array("ورقة1", "ورقة2", "ورقة3")).Select

المرفق يحتوي على طريقتين بدل طريقة واحدة لتنفيذ ما أشرت إليه، الكود في الصفحة الأولى يحتوي على شرح ما طلبته، شاهد المرفق، IF_Function_2.rar

أستخدم أحد الدالتين التاليتين: 1- =SUMPRODUCT(D9,D11) 2- =PRODUCT(D9,D11)

شاهد المرفق، SHIPMENT_PLAN_SEARCH.rar

بالنسبة لعميلة الضرب العادية .. فيتم فيها إستخدام علامة النجمة ( * ) بدلاً من علمة الضرب المعروفة ( × ). أما إذا كنت تبحث عن دوال الضرب في كثيرة أخي الكريم ومنها PRODUCT، SUMPRODUCT, DPRODUCT .. وغيرهم ولكن تحتاج إلى تحديد أي نوع من الضرب تريد.

ألف شكر لك أخي آدم على هذا الإهتمام الواضح والجهد المبذول. وأتمنى منك أن تكمل مشروعك بإضافة جميع المواضيع المهمة والمتعلقة ببقية الأعضاء أيضاً .. حتى يصبح مشروعك مرجع أساسي لجميع أعضاء المنتدى .. يسهل عليهم البحث عما يحتاجون إليه. وإذا واصلت ما بدأته .. سوف نعمل على تثبيت موضوعك بشكل دائم. شكراً لك مر ةً أخرى،

شكراً لك أخي الكريم،

أرسل ملف على إيميلي الموجود في توقيعي .. لكي أجري التعديل اللازم عليه،

وهذا هو رابط الموضوع الأصلي: http://www.officena.net/ib/index.php?showtopic=14038

بكل سرور .. شاهد المرفق التالي والذي يحتوي على كود لفزر الأرقام تصاعدياً وتنازلياً وبدون تكرار. _________________________________________________.rar

أشكرك أخي حسام على هذا الإطراء، إضافة جديدة وتعديل مهم على كود الترحيل .. لمن أحب يفضل إعادة تحميل المرفق من جديد،

إذهب إلى محرر الفيجوال .. وأنظر الكود الذي يعمل عند فتح الملف والموجود داخل الموديول This Workbook .. وستجد الإجابة على جميع تساؤلاتك.