دليل وظائف LOOP

[الزباري]

وهذه طريقة أخرى

لاحظ بأن تلوين السطر غير محدد.. فـ

سؤالنا التالي: أعد كتابة الكود بحيث يظهر لنا في نطاق محدد من a1:d20 كالتالي:

[توكل]

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

Sub row_col()
  Dim Col As Long
  Dim Row As Long
  For Col = 1 To 4
    For Row = 1 To 20 Step 3
      Cells(Row, Col).Interior.Color = RGB(200, 200, 200)
    Next Row
  Next Col
End Sub

 

[محمد حمدان]

 Dim i As Integer
 Dim j As Integer
 
 For j = 1 To 4
    For i = 1 To 20
    Cells(i, j).Interior.Color = RGB(200, 200, 200)
    i = i + 2
    Next i
 Next j

[الزباري]

بارك الله فيكما..

[توكل]

أستاذي الزباري كل هذا بفضل علمك الذي تفضلت به علينا بارك الله فيك

 

تم تعديل أكتوبر 27, 2016 بواسطه توكل

[الزباري]

سؤالنا القادم: كيف نختار الجدول بشكل تلقائي (ديناميكي) ومن ثم نظلله.. بمعنى أن الكود يصلح لأي حجم .. فلا داعي بأن تذكر له عدد الصفوف ولا عدد الأعمدة؟!!! 

كالمثال التالي:

 

[الزباري]

الإجابة في هذا الكود:

Range("a1").Select
Do Until ActiveCell.Value = ""
Range(ActiveCell, ActiveCell.End(xlToRight)).Interior.ColorIndex = 20
ActiveCell.Offset(1, 0).Select
Loop

الشرح:

أولاً: اخترنا الخلية a1

ثانياً: كتبنا حلقة تكرارية تبحث عن الخلايا الفارغة

ثالثا: ظللنا الخلايا على يمين a1 إلى أن يجد خلية فارغة (وهذا يمثل عدد الأعمدة)

رابعا: نزلنا إلى b1 وطبقنا الفقرة السابقة وهكذا إلى أن نصل إلى آخر صف.

[الزباري]

سؤالنا الأخير لهذا اليوم:

في المثال السابق ، كيف أجبر الكود بأن يظلل الأسطر التي تحتوي على نوع student كالتالي:

[سليم حاصبيا]

اسمحوا لي بهذا الكود

Sub tlween1()

Range("a1").CurrentRegion.Interior.ColorIndex = xlNone
Cells(1, 1).Activate
    Do While ActiveCell <> ""
       If ActiveCell.Offset(0, 1) = "student" Then _
       ActiveCell.Resize(1, 3).Interior.ColorIndex = 4
       ActiveCell.Offset(1, 0).Activate
     Loop
End Sub

تم ادراج اول سطر بالكود لاعادة اللون السابق في حال انتقلت كلمة Student من صف الى اخر

ملاحظة اخرى:

ماذا لو كتبت كلمة student بهذا الشكل  StuDent أو sTuDEnt  أو غيره

سؤال لعشاق ال VBA

 

[أبو حنــــين]

السلام عليكم

بالنسبة لسؤال أخي سلم

Sub tlween1()

Range("a1").CurrentRegion.Interior.ColorIndex = xlNone
Cells(1, 1).Activate
    Do While ActiveCell <> ""
       If Trim(LCase(ActiveCell.Offset(0, 1).Value)) = Trim(LCase("student")) Then _
       ActiveCell.Resize(1, 3).Interior.ColorIndex = 4
       End If
       ActiveCell.Offset(1, 0).Activate
     Loop

End Sub

 

و هناك كود آخر يعمل نفس العمل

Sub Text2()

Dim c As Range
For Each c In ActiveSheet.UsedRange
If Trim(LCase(c.Value)) = Trim(LCase("student")) Then Range(Cells(c.Row, 1), Cells(c.Row, 3)).Interior.ColorIndex = 4
Next

End Sub

 

[الزباري]

الأخ/ سليم حاصبيا المحترم

والأخ/أبو حنــــين المحترم

يشرفني مروركم، ومشاركتكم، فأنتم سباقون في هذا المجال.

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

تقبلوا تحياتي

[أبو حنــــين]

السلام عليكم

بالفعل أخي الزباري و في هذه الحالة سنحسب آخر عمود بناءا على عناوين الصف الأول و نسميه مثلا  :  LastCol 

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

ثم نغير الرقم  3  في الكود بالمتغير  LastCol  

[الزباري]

جميل ولكنك لم تستفد من الدالة loop للبحث عن نهاية العمود، وهذا هو هدفنا.

[سليم حاصبيا]

9 دقائق مضت, أبو حنــــين said:

السلام عليكم

بالفعل أخي الزباري و في هذه الحالة سنحسب آخر عمود بناءا على عناوين الصف الأول و نسميه مثلا  :  LastCol 

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

ثم نغير الرقم  3  في الكود بالمتغير  LastCol  

وماذا اذا كان عدد الاعمدة متغير (كل صف له عدد من الاعمدة مختلف عن الاخر )

[الزباري]

الإجابة في هذا الكود:

Range("a1").Select
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.Value = ""
If ActiveCell.Offset(0, 1).Value = "student" Then
Range(ActiveCell, ActiveCell.End(xlToRight)).Interior.ColorIndex = 20
End If
ActiveCell.Offset(1, 0).Select
Loop

 

المرفق:

loop_shaddow.rar

[أبو حنــــين]

جميل

ما الذي يحدث لو كانت إحدي الخلايا فارغة في العمود A

جرب مسح الخلية  A4  مثلا

تم تعديل أكتوبر 28, 2016 بواسطه أبو حنــــين

[سليم حاصبيا]

48 دقائق مضت, أبو حنــــين said:

جميل

ما الذي يحدث لو كانت إحدي الخلايا فارغة في العمود A

جرب مسح الخلية  A4  مثلا

عندها يلزم هذا الكود (مع الاخذ بعين الاعتبار مشاركتكم السابقة حول عدد الاعمدة)

لم اذكرها هنا لضيق الوقت

Sub salim1()
lr = Cells(Rows.Count, 1).End(3).Row
Range("a1:f" & Cells(Rows.Count, 1).End(3).Row).Interior.ColorIndex = xlNone


Set my_rg = Range("a1:a" & lr).SpecialCells(xlCellTypeConstants)
    k = my_rg.Areas.Count
      For x = 1 To k
             For y = 1 To my_rg.Areas(x).Count
                If my_rg.Areas(x).Cells(y).Offset(0, 1) = "student" Then _
                my_rg.Areas(x).Cells(y).Resize(1, 6).Interior.ColorIndex = 4
             Next
       Next

End Sub

 

[أبو حنــــين]

جميل لكن الأخ  الزباري يريد  استعمال الدالة   loop  و إلا فالطرق كثيرة للحصول على النتيجة

[سليم حاصبيا]

5 ساعات مضت, أبو حنــــين said:

جميل لكن الأخ  الزباري يريد  استعمال الدالة   loop  و إلا فالطرق كثيرة للحصول على النتيجة

تكرم عينك و عينه

Sub salim2()

     With Range("a1:f" & Cells(Rows.Count, 1).End(3).Row)
        .Interior.ColorIndex = xlNone
        .Borders.LineStyle = xlContinuous = 0
     End With
     
Set my_rg = Range("a1:a" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeConstants)
k = 1
        Do Until k = my_rg.Areas.Count + 1
         y = 1
            Do Until y = my_rg.Areas(k).Count + 1
            my_rg.Areas(k).Cells(y).Activate
            If ActiveCell.Offset(0, 1) = "student" Then
             With ActiveCell.Resize(1, ActiveCell.Columns.End(xlToRight).Column)
                 .Interior.ColorIndex = 4
                 .Borders.LineStyle = xlContinuous = 1
               End With
                End If

           y = y + 1
            Loop
            k = k + 1
        Loop
Range("a1").Select
End Sub

 

[أبو حنــــين]

جميل و يمكن ان نستعمل كود آخر

Sub Text3()
	i = 1
	Do While i <= Cells(Rows.Count, "A").End(xlUp).Row
	If Trim(LCase(Cells(i, 2))) = Trim(LCase("student")) Then _
	Range(Cells(i, 1), Cells(i, Cells(1, Columns.Count).End(xlToLeft).Column)).Interior.ColorIndex = 4
	i = i + 1
	Loop
End Sub

 

[الزباري]

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

وتقبلوا تحياتي.

ترقبوا سؤالنا التالي بعد قليل..

10 ساعات مضت, سليم حاصبيا said:

وماذا اذا كان عدد الاعمدة متغير (كل صف له عدد من الاعمدة مختلف عن الاخر )

أعتقد أنه علينا أن نتعامل مع الصف الأول (رؤوس الأعمدة) في تحديد عدد الأعمدة..

[الزباري]

سؤالنا: ماذا لو غيرنا مكان الجدول، ولم نكن نعرف مكانه بالضبط ، كيف يمكننا تطبيق الكود السابق عليه، كالجدول التالي مثلاً: (زادت المسائل تعقيداً)

تم تعديل أكتوبر 28, 2016 بواسطه الزباري

[الزباري]

حيث أن الكود السابق هو:

وكل ما يمكنك التفكير به هو تغيير الكود بداخل المستطيل الأحمر

[سليم حاصبيا]

الهدف الاول تحديد اول خلية في الجدول

و ذلك يتم بواسطة هذا الكود

Sub first_cell()
For i = 1 To ActiveSheet.Columns.Count
On Error Resume Next
Set My_rg = Columns(i).SpecialCells(xlCellTypeConstants).Cells(1)
 If Not IsEmpty(My_rg) Then
 Err.Clear
  Exit For
 End If
 Next
r = My_rg.Row: c = My_rg.Column
'======================================
' من هنا يمكن متابعة الكود
'بعد ان عرفنا اول خلية في الجدول


'=======================================
End Sub

 

[سليم حاصبيا]

موضوع اخر خطر على بالي

كيف نحول جدول من شكل الى اخر

انظر الى المرفق

ملاحظة(الكود فيما بعد)

 

for VBA lovers.rar