الحلقة التكرارية For next
نستخدم الحلقة التكرارية for - next :
عندما نريد تنفيذ امر او عدة اوامر محددة على خلايا معينة فى الاكسل ؛
مثل اعطاء تقديرات الطلاب بدون معادلات ؛
او تلوين خلايا او تلوين خطوط او ادراج شيتات باسماء موجودة فى العمود وهكذا؛
ويكون تكوين الحلقة التكرارية عند كتابتها فى الفيجوال بيسيك vba كالتالى :
ولتفهم كيفية عمل الحلقة التكرارية شاهد الفيديو التالى :
المثال الاول للعمل على الحلقة التكرارية :
1- اعطاء تقديرات للطلاب بدون معادلات
ويكون الكود هو :
Sub تقديرات()
For i = 2 To 13
If Cells(i, 2).Value < 50 Then
Cells(i, 3).Value = "راسب"
Else
Cells(i, 3).Value = "ناجح"
End If
Next i
End Sub
المثال الثانى :
2- تلوين اسماء محددة فى عمود محدد باللون الاحمر واعطاء الخط الحجم السميك
bold.
وتلوين اسم مع ترك اسمين وهكذا لنهاية العمود .
والكود المستخدم هو :
Sub Macro1()
Dim lrow As Long
lrow = Application.WorksheetFunction.CountA(Range("a:a"))
For i = 1 To lrow Step 2
ActiveCell.Font.Color = vbRed
ActiveCell.Font.Bold = True
ActiveCell.Offset(3, 0).Select
Next i
End Sub
المثال الثالث :
3- افتراض متغير عددى counter من 1 الى 2 مثلا
واضافة شيتات جديدة بعدد المتغير counter واعطاء اسم للشيتات باسم المتغير العددى
ويكون الكود كالتالى :
Sub Macro3()
For counter = 1 To 2
Sheets.Add
ActiveSheet.Name = counter
Next counter
End Sub
المثال الرابع :
4 - اجابة على احد الاسئلة الواردة لصفحتنا لـــــغـــــة الاكــــــســــــل
وشرحنا الحل فى الفيديو واستخدمنا الاكواد التالية :
Sub Macro2()
Application.ScreenUpdating = False
Macro11
Sheets("ورقة1").Activate
For i = 1 To 50
If Sheets("ورقة1").Cells(i, 1).Value <> "الرقم" And Sheets("ورقة1").Cells(i, 1).MergeCells = False Then
Sheets("ورقة2").Cells(i, 2).Value = Sheets("ورقة1").Cells(i, 1).Value
Sheets("ورقة2").Cells(i, 3).Value = Sheets("ورقة1").Cells(i, 2).Value
Sheets("ورقة2").Cells(i, 4).Value = Sheets("ورقة1").Cells(i, 3).Value
Sheets("ورقة2").Cells(i, 5).Value = Sheets("ورقة1").Cells(i, 4).Value
Sheets("ورقة2").Cells(i, 6).Value = Sheets("ورقة1").Cells(i, 5).Value
Sheets("ورقة2").Cells(i, 7).Value = Sheets("ورقة1").Cells(i, 6).Value
End If
If Sheets("ورقة1").Cells(i, 1).MergeCells = True Then
Sheets("ورقة2").Cells(i + 2, 1).Value = Sheets("ورقة1").Cells(i, 1)
End If
Next i
Macro4
تنسيق
End Sub
حيث يتم ادراج مديول فى المطور وكتابة الاكواد السابقة ؛ ثم ادراج شكل معين فى الشيت وكليك يمين على الشكل واختيار Assign Macro
وتحديد الماكرو المكتوب ثم OK
لاحظ ان Macro11:
مسئول عن الغاء الفلترة قبل تنفيذ الاضافة
ويكون كالتالى :
Sub Macro11()
Sheets("ورقة2").Activate
Range("A3:G23").Select
Selection.ClearContents
ActiveSheet.Range("$A$1:$G$54").AutoFilter Field:=2
Range("B1").Select
End Sub
لاحظ ان Macro4:
لعمل الفلترة بعد نقل البيانات ويكون كالتالى :
Sub Macro4()
Application.ScreenUpdating = False
Sheets("ورقة2").Activate
Columns("A:G").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$G$54").AutoFilter Field:=2, Criteria1:="<>"
Range("B1").Select
End Sub
لاحظ ان تنسيق:
لاعطاء تنسيق مناسب للخطوط فى الجدول بعد الفلترة ؛
ولتفهم عمل الكود لابد من متابعة الفيديو .
ليست هناك تعليقات:
إرسال تعليق