دليل وظائف LOOP

[الزباري]

سؤالنا القادم.. كيف يمكننا معرفة أول خلية فارغة في العمود الأول باستخدام الدالة do until؟ 

[الزباري]

الإجابة:

Dim i As Integer
i = 0
Do
i = i + 1
Loop Until Cells(i, 1).Value = ""
MsgBox "Cell A" & i & " is blank!"

 

لاحظ بأن until كُتبت بعد Loop ، وهذا طريقة أخرى للترتيب، وقد استخدمت لأن الشرط يعتمد على نتيجة خلية.

وهذه طريقة أخرى اعتمدت على شرط أنه إذا كانت الخلية فارغة فأعطها true

Dim BlankFound As Boolean
Dim x As Long

'Loop until a blank cell is found in Column A
  Do Until BlankFound = True
    x = x + 1
    
    If Cells(x, "A").Value = "" Then
      BlankFound = True
    End If
  Loop

'Report out first blank cell found in Column A
  MsgBox "Cell A" & x & " is blank!"

إلى هنا انتهت الحلقة الثانية ودمتم سالمين

وهذا هو الملف المرفق

first_blank.rar

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

[الزباري]

3- الدالة Do while loop

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

فمثلاً لو طُلب منك بأن تكتب أرقام متسلسلة في العمود الأول وتضع شرطاً بأن ينفذ الأمر عندما يكون الرقم أصغر من 11، فعندها سيكون الكود كالتالي :

i = 1

Do While i < 11
        
   Cells(i, 1) = i
   i = i + 1
       
Loop

لاحظ النتيجة وقارن بينها وبين أول مثال من do until

i = 1
Do Until i = 11
   Cells(i, 1) = i
   i = i + 1
Loop

فهما يؤديان إلى نفس النتيجة

شاهد المرفق

do_while_01.rar

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

[إبراهيم ابوليله]

اخى الفاضل

الزبارى

شرح جميل ووافى

بارك الله فيك

[توكل]

ما شاء الله عليك جزيت خيراً أنا متابع معك خطوة بخطوة

[الزباري]

عادة تستخدم الدالة do while في القيام بعملية مكررة في عمود محدد، فمثلا نستخدمها في عمليات الجمع كما في المثال التالي

r = 4
Do While Cells(r, 1) <> ""
Cells(r, 4) = Cells(r, 2) * Cells(r, 3)
r = r + 1
Loop

المرفق:

do_while_02.rar

الشرح

في السطر الأول حددنا رقم الصف الذي ستبدأ منه الدالة

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

ومن ثم أدخلنا معادلة الإجمالي

والسطر الأخير يعني أن ينتقل صف واحد للبحث عن الشرط

[الزباري]

ولو أردنا أن نكتب الإجمالي في نهاية السطر فنضيف إليها الكود التالي:

r = 4
Sum = 0
Do While Cells(r, 1) <> ""
Sum = Sum + Cells(r, 4)
r = r + 1
Loop
Cells(r, 3) = "الإجمالي"
Cells(r, 4) = Sum

شاهد طريقة الربط في المرفق

do_while_03.rar

إلى هنا انتهى درسنا لهذه الدالة، وترقبوا مني أمثلة للأفكار الذكية في استخدام  هذه الدوال والتي تزيد من توسيع مدارككم بها، وتقبلوا تحياتي

[الزباري]

سؤالنا: ما هو الكود الذي يعرض لنا الأرقام الفردية فقط  من 1 - 15 كالمثال التالي؟

 

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

[محمد حمدان]

i = 1

do untit i=16

cells(i,1) =i

i= i+2

loop

[توكل]

أعتقد ان الكود التالي سيفي بالغرض

Sub odd()

Dim i As Integer

For i = 1 To 16
   Cells(i, 1) = i
   i = i + 1
Next i

End Sub

جعل الله هذا العلم في صحائف أستاذنا الزباري وفي صحائف كل من علمنا في هذا المنتدي الرائع

[الزباري]

4 ساعات مضت, محمد حمدان said:

i = 1

do untit i=16

cells(i,1) =i

i= i+2

loop

بارك الله فيك، لكن i مستحيل تساوي 16، لأن الأرقام تكون فردية، فعند تنفيذ الكود فإنه لن يتوقف لأنه لم يحصل على العدد 16.

والصواب :

استبدل ب i>16

ولاتنسى تعديل كلمة until

وستكون النتيجة صحيحة 

2 ساعات مضت, توكل said:

أعتقد ان الكود التالي سيفي بالغرض

Sub odd()

Dim i As Integer

For i = 1 To 16
   Cells(i, 1) = i
   i = i + 1
Next i

End Sub

جعل الله هذا العلم في صحائف أستاذنا الزباري وفي صحائف كل من علمنا في هذا المنتدي الرائع

بارك الله فيك، ما شاء الله عليك ضربة معلم 

وسنوافيكم بطريقة أخرى للحل ولكن بعد الإجابة على السؤال التالي:

سؤالنا: من المثال السابق كيف نجبر الكود بعدم ترك أسطر فارغة كالشكل التالي:

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

[إبراهيم ابوليله]

ممكن كده بردو

Sub odd()

Dim i As Integer
For i = 1 To 16 Step 2
   Cells(i, 1) = i
 Next i

End Sub

 

[الزباري]

تحياتي لك يا إبراهيم ابوليله

فقد قرأت أفكاري، سنبدأ بهذه الإضافة (step) بعدما نجيب على السؤال السابق.. ومنك نتعلم.

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

السلام  عليكم

جزاك الله خيرا أخي الزباري على هذا الشرح 

لفتت إنتباهي كلمة في كود أخي إبراهيم أبو ليله في سطره الأول : و هي كلمة odd

فأردت المشاركة بإستعمال هذه الكلمة :

Sub test()
    Dim i As Integer, x As Integer
    x = 1
        For i = 1 To 16 Step 2
            Cells(x, 1) = WorksheetFunction.Even(i)
            Cells(x, 2) = WorksheetFunction.Odd(i)
        x = x + 1
    Next i
End Sub

 

[توكل]

3 ساعات مضت, الزباري said:

سؤالنا: من المثال السابق كيف نجبر الكود بعدم ترك أسطر فارغة كالشكل التالي:

من مشاركة أبي حنين يمكن لهذا الكود أن يعطينا الجواب

Sub odd()

Dim i As Integer, x As Integer
    x = 1
    For i = 1 To 16 Step 2
    Cells(x, 1) = WorksheetFunction.odd(i)
    x = x + 1
   
Next i

End Sub

طبعاً محاولة متواضعة من تلميذ مازال يحبو في عالم vba

[الزباري]

بالراحة علينا يا أبو حنــــين

برافو عليك يا توكل

 

بس ممكن نكتب كود بدون function

ترقبونا

[الزباري]

الجواب سيكون في هذا الكود السهل الممتنع:

Dim i As Integer
j = 1
For i = 1 To 16
   Cells(j, 1) = i
   i = i + 1
   j = j + 1
Next i

 

الحلقة التكرارية4.rar

[توكل]

منذ ساعه, الزباري said:

بالراحة علينا يا أبو حنــــين

برافو عليك يا توكل

 

بس ممكن نكتب كود بدون function

ترقبونا

يا سيدي أنا لازلت أحبو في هذا المجال ومشاركة أبي حنين جزاك الله وإياه كل خير، هي يلي علمتني كيف أكتب الكود

[الزباري]

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

[محمد حمدان]

شكرا استاذ زباري . وجزيت خيرا .

وان شاء الله نستفيد اكثر على يديك .

[الزباري]

هل من الممكن تطبيق الدالة على متتالية معينة، مثلا بأن يتم تطبيقها كل سطر أو سطرين وهكذا؟

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

فمثلاً لو أردنا أن نظهر نتيجة جمع الأعداد الفردية من 1 إلى 1000 فسيكون الكود بهذا الشكل:

Dim Total As Double
  Dim Cnt As Long
  Total = 0
  For Cnt = 1 To 1000 Step 2
    Total = Total + Cnt
  Next Cnt
  MsgBox Total

المرفق:

count_odd.rar

[الزباري]

سؤالنا التالي: ما هو الكود المناسب لتلوين الأسطر من 1 إلى 100 لتحصل على هذه النتيجة :

علماً بأن كود التلوين هو :

Rows(i).Interior.Color = RGB(200, 200, 200)

 

[توكل]

2 ساعات مضت, الزباري said:

سؤالنا التالي: ما هو الكود المناسب لتلوين الأسطر من 1 إلى 100 لتحصل على هذه النتيجة :

علماً بأن كود التلوين هو :

Rows(i).Interior.Color = RGB(200, 200, 200)

 

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

Sub Rowscolor()
Dim i As Integer
    i = 1
    For i = 1 To 100 Step 3
    Rows(i).Interior.Color = RGB(200, 200, 200)
    i = i
   
Next i

End Sub

هل أجبت الجواب الصحيح أم أن في جعبتكم شيء آخر؟

[الزباري]

[محمد حمدان]

 Dim i As Integer
 For i = 1 To 100
 Rows(i).Interior.Color = RGB(200, 200, 200)
 i = i + 2
 Next i