دليل وظائف 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.rarFetching info...

تم تعديل أكتوبر 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.rarFetching info...

تم تعديل أكتوبر 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.rarFetching info...

الشرح

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

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

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

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

[الزباري]

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

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.rarFetching info...

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

[الزباري]

سؤالنا: ما هو الكود الذي يعرض لنا الأرقام الفردية فقط  من 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

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

[الزباري]

  في 26‏/10‏/2016 at 07:06, محمد حمدان said:

i = 1

do untit i=16

cells(i,1) =i

i= i+2

loop

Expand  

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

والصواب :

استبدل ب i>16

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

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

  في 26‏/10‏/2016 at 08:34, توكل said:

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

Sub odd()

Dim i As Integer

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

End Sub

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

Expand  

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

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

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

تم تعديل أكتوبر 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

 

[توكل]

  في 26‏/10‏/2016 at 11:15, الزباري said:

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

Expand  

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

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.rarFetching info...

[توكل]

  في 26‏/10‏/2016 at 16:18, الزباري said:

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

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

 

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

ترقبونا

Expand  

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

[الزباري]

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

[محمد حمدان]

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

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

[الزباري]

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

جاءت دالة 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.rarFetching info...

[الزباري]

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

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

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

 

[توكل]

  في 27‏/10‏/2016 at 04:24, الزباري said:

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

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

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

 

Expand  

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

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