علي السحيب

هل هذا ما تريد،

_______________.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 ؟

لن يتم إعطاء أي لون للرقم المكرر الذي يبلغ تسلسلة أكبر من 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)

=PRODUCT(D9,D11)

شاهد المرفق،

SHIPMENT_PLAN_SEARCH.rar

بالنسبة لعميلة الضرب العادية .. فيتم فيها إستخدام علامة النجمة ( * ) بدلاً من علمة الضرب المعروفة ( × ).

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

ألف شكر لك أخي آدم على هذا الإهتمام الواضح والجهد المبذول.

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

وإذا واصلت ما بدأته .. سوف نعمل على تثبيت موضوعك بشكل دائم.

شكراً لك مر ةً أخرى،

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

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

وهذا هو رابط الموضوع الأصلي:

http://www.officena.net/ib/index.php?showtopic=14038

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

_________________________________________________.rar

أشكرك أخي حسام على هذا الإطراء،

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

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