دليل وظائف LOOP

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

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

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

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

Expand  

في هذه الحالة  علينا ان نحذف السطر  :  Range("a1").Select

و نضع مكانه السطر  : ActiveSheet.UsedRange.Select

[الزباري]

 

سأزيد المسألة تعقيداً.. انتظر السؤال التالي.

لو كان للجدول عنوان ، ويوجد فراغ بينه وبين الجدول، فكيف سنطبق الكود؟  (شاهد الجدول التالي)

[الزباري]

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

Cells.Find("name").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

 

لاحظ أننا استفدنا من عناوين الجدول للتعرف عليه

  في 27‏/10‏/2016 at 19:11, سليم حاصبيا said:

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

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

 

Expand  

أعتقد بأن الدالة find تبحث على الإسم بجميع صيغه.

وتقبل تحياتي

[الزباري]

  في 28‏/10‏/2016 at 21:17, سليم حاصبيا said:

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

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

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

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

 

for VBA lovers.rarFetching info...

Expand  

سؤالنا التالي: سؤال تحدي من أستاذنا سليم حاصبيا.. وبها فكرتين، الأولى العد التنازلي، والثانية الدمج.. بانتظار الإجابة

[الزباري]

اسمحلي بهذه الإجابة

Dim i As Integer
Dim j As Integer
j = 0
Do
j = j + 1
Loop Until Cells(j, 2).Value = ""

For i = j - 2 To 1 Step -1
     If Cells(i + 1, 1) = "" Then Range(Cells(i, 1), Cells(i + 1, 1)).Merge
Next i

طبعاً ينقصها التنسيق..

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

و لإثراء الحلول هذه طريقة أخرى تؤدي نفس العمل

Sub Test5()

Application.ScreenUpdating = False
    For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
        If Not Cells(i, 1) = "" Then
        x = Range("A" & i).Row: GoTo 200: End If
        If Cells(i, 1) = "" Then
        xx = Range("A" & i).Row: GoTo 100: End If
100
        With Range(Cells(x, 1), Cells(xx, 1))
       .Merge: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
        End With
200
    Next
Application.ScreenUpdating = True

End Sub

 

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

  في 29‏/10‏/2016 at 15:19, أبو حنــــين said:

و لإثراء الحلول هذه طريقة أخرى تؤدي نفس العمل

Sub Test5()

Application.ScreenUpdating = False
    For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
        If Not Cells(i, 1) = "" Then
        x = Range("A" & i).Row: GoTo 200: End If
        If Cells(i, 1) = "" Then
        xx = Range("A" & i).Row: GoTo 100: End If
100
        With Range(Cells(x, 1), Cells(xx, 1))
       .Merge: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
        End With
200
    Next
Application.ScreenUpdating = True

End Sub

 

Expand  

حل ممتاز 

لكن الاخ الزباري يريدها عن طريق Loop

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

بالاضافة الى حل الاخ ابو حنين (For Next)

حلين اخرين 

1-بواسطة Loop

2-بواسطة Array

for VBA lovers Two In One.rar

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

  في 29‏/10‏/2016 at 16:52, سليم حاصبيا said:

حل ممتاز 

لكن الاخ الزباري يريدها عن طريق Loop

Expand  

إنني وقعت في نفس الذي وقعت فيه أنت سابقا حينما اجبت عن السؤال و قلت لك يومها ان  الاخ الزباري يريدها عن طريق Loop

كما تدين تدان

  في 29‏/10‏/2016 at 17:22, سليم حاصبيا said:

بالاضافة الى حل الاخ ابو حنين (For Next)

حلين اخرين 

1-بواسطة Loop

2-بواسطة Array

for VBA lovers Two In One.rarFetching info...

Expand  

الحل الجميل و الذي اعجبني هو عن طريق  Array

[الزباري]

هههههه.. هذه بتلك 

وكل حل أفضل من الثاني

على العموم انتهينا من هذا الفصل وترقبوا الفصل الأخير والذي يحتوي على بعض الألغاز السهلة للدالة وآلية تكوينها بصورة مبسطة.

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

[توكل]

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

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

[الزباري]

الأخ/ توكل  المحترم

أشكر اهتمامك في الموضوع

وعاوزين منك انه تروينا من الكراسة العجيبة الكود الذي يرتب الأرقم من 1 إلى 10 ولكن هذه المرة بشكل تنازلي كالشكل التالي:

[ياسر خليل أبو البراء]

بارك الله فيك أخي الحبيب الزباري على هذا الموضوع الجميل والمفيد

آخر سؤال : اقلب الحلقة واستخدم كلمة Step -1 لأننا ماشيين بالمقلوب ، زي ما الدنيا كلها ماشية بالمقلوب

تقبل صباحي

[الزباري]

صباح الخير أ.ياسر

الكود تبعك خلاها تمشي عدل

في جزئية بسيطة ويكون الكود صحيح وتمشي بالمقلوب

وتقبل تحياتي

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

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

جرب هذا الكود

Sub Makloub()
i = 1
answer = Application.InputBox("type yourNumber", "Salim you ask", 5)
 t = Abs(Val(answer))
                If t = 0 Then GoTo 1
With ActiveCell
      .Value = "number from" & Chr(10) & t & " to " & 1
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .Offset(1, 0).Resize(500, 1).ClearContents
End With
    Do Until i > t
     ActiveCell.Offset(t - i + 1, 0) = i
     i = i + 1
     Loop
     Exit Sub
1:
     MsgBox "You must type  a Positive number"
     
End Sub

 

[توكل]

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

الأخ/ توكل  المحترم

أشكر اهتمامك في الموضوع

وعاوزين منك انه تروينا من الكراسة العجيبة الكود الذي يرتب الأرقم من 1 إلى 10 ولكن هذه المرة بشكل تنازلي كالشكل التالي:

Expand  

أعتقد أن الكود البسيط هذا يحقق المطلوب

Sub z_to_a()
    Dim i As Integer
For i = 1 To 10
x = 11
   Cells(i, 1) = x - i
 Next i
End Sub

 

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

  في 30‏/10‏/2016 at 06:35, توكل said:

أعتقد أن الكود البسيط هذا يحقق المطلوب

Sub z_to_a()
    Dim i As Integer
For i = 1 To 10
x = 11
   Cells(i, 1) = x - i
 Next i
End Sub

 

Expand  

ممتاز

لكن حبذا عدم التقيد بالرقم 10 ودع المستخدم يختار الرقم الذي يريده

[جلال الجمال_ابو أدهم]

 

أبو حنــــين

سليم حاصبيا

ياسر خليل أبو البراء

الزباري

الاخوه الافاضل ما شاء الله عليكوا
تحياتى

 

[الزباري]

الهدف من هذا المثال توضيح بأن الكود التالي يحقق نفس النتيجة:

Dim i As Integer
    For i = 10 To 1 Step -1
    x = 11
    Cells(i, 1) = x - i
 Next i

حيث أنه لما قلبنا الحلقة واستخدما step-1 لم تقلب النتيجة ، ولكنها بدأت من الصف الأخير إلى الأول

[توكل]

  في 30‏/10‏/2016 at 07:09, سليم حاصبيا said:

ممتاز

لكن حبذا عدم التقيد بالرقم 10 ودع المستخدم يختار الرقم الذي يريده

Expand  

أخي سليم يمكن للكود التالي أن يجيب على سؤالك

Sub z_to_a()
    Dim i As Integer
    answer = Application.InputBox("type yourNumber")
 x = Abs(Val(answer))
For i = 1 To x
x = Abs(Val(answer))
   Cells(i, 1) = x + 1 - i
 Next i
End Sub

 

[الزباري]

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

ترقبوا سؤالنا التالي

[مختار حسين محمود]

 

   بارك الله فيك أخى الزيارى وفى وقتك وجهدك  موضوع رائع ومفيد لكل محبى الفيجوال بيزك

تحياتى

[الزباري]

سؤال التحدي لهذا اليوم:

ما هو الكود الذي يظلل الصفوف بحسب الأشهر الفردية بمعنى يظلل شهر ويترك شهر، كما في المثال التالي:

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

  في 30‏/10‏/2016 at 10:33, الزباري said:

سؤال التحدي لهذا اليوم:

ما هو الكود الذي يظلل الصفوف بحسب الأشهر الفردية بمعنى يظلل شهر ويترك شهر، كما في المثال التالي:

Expand  

رجاءً ارفع الملف نفسه وليس صورة 

و ذلك للتعامل معه بشكل افضل

ربما الحالة هذه ليس بحاجة الى كود

يكفي النتسيق الشرطي  (مرفق مثال)

Talween_Month.rar

[الزباري]

شكراً على المرفق، التنسيق الشرطي خارج موضوعنا ، نريد أن نتعامل مع دالة Loop، تفضل المرفق:

dt.rarFetching info...

 

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