1. Schemat działania pętli Do While Loop
Pętla While…Wend, którą poznaliśmy w poprzednim rozdziale jest najprostszą pętlą w Excelowym VBA. Pętla, która daje nam więcej możliwości to Do…Loop. Daje nam ona wiele więcej możliwości. Możemy np zakończyć wykonywanie instrukcji wcześniej, poprzez wprowadzenie warunku wyjścia. Nasza kontrola nad wykonywaniem instrukcji jest znacznie większa. Poniżej podstawowy schemat pętli Do…Loop:
Do [Rodzaj Warunku] [Warunki] [Instrukcje] Loop
2. Rodzaje pętli Do…Loop
Pętle Do…Loop możemy podzielić na 5 kategorii. Ich dokładny opis zamieszczam w tabelce poniżej.
Rodzaj pętli | Opis |
Do While Loop | Pętla z warunkiem wejścia. Pętla Do While Loop uruchamia się po raz pierwszy, gdy warunek jest spełniony. Oznacza to tyle co „odtwarzaj instrukcję gdy warunek jest spełniony”. |
Do Until Loop | Pętla z warunkiem wyjścia. Pętla uruchamia się po raz pierwszy i działa do momentu, aż warunek zostanie spełniony. Oznacza to tyle co „odtwarzaj instrukcję, dopóki warunek zostanie spełniony”. Gdy warunek zostanie spełniony następuje wyjście z pętli |
Do Loop While | Pętla z warunkiem wejścia. Pętla uruchamia się i wykonuje 1 raz, po czym następuje sprawdzenie, czy instrukcja może wejść w pętlę po raz kolejny. Gdy warunek jest spełniony pętla uruchomi się po raz kolejny. |
Do Loop Until | Pętla z warunkiem wyjścia. Pętla uruchamia się i wykonuje 1 raz, po czym następuje sprawdzenie, czy instrukcja może wejść w pętlę po raz kolejny. Gdy warunek jest spełniony nastąpi wyjście z pętli. |
Do Loop | Pętla bez określonego warunku. Możemy ją zatrzymać np przy pomocy instrukcji Exit Loop oraz instrukcji If Then Else. |
Naszą pętlę możemy zakończyć przed spełnieniem warunku. Służy do tego instrukcja Exit Do. Używamy jej np, gdy chcemy, by jeszcze jakiś dodatkowy warunek mógł zakończyć pętle. Warunek, którego nie napisaliśmy po While lub Until.
3. Przykład pętli w pętli
Spróbujmy zrobić w naszym arkuszu VBA prostą tabliczkę mnożenia. Wykorzystamy do tego celu poznane nam pętle Do Until Loop i Do loop Until. W pierwszej kolejności stwórzmy prostą pętlę, wypełniającą nam 10 kolumn pierwszego wiersza w naszym arkuszu:
Sub LoopExample1() Dim intRow As Integer Dim intCol As Integer intRow = 1 intCol = 1 Do Cells(intRow, intCol) = intCol * intRow intCol = intCol + 1 Loop Until intCol = 10 End Sub
W powyższym przykładzie celowo wprowadziliśmy od razu obie zmienne dla kolumn i wierszy. Wykorzystamy je w pełni kończąc nasz przykład. Gdy mamy już makro wypełniające pierwszy wiersz, zapętlamy je powiększając za każdym razem licznik dla wierszy o 1. W ten sposób w naszym arkuszu utworzy się tabliczka mnożenia do 100.
Sub LoopExample1() Dim intRow As Integer Dim intCol As Integer intRow = 1 Do Until intRow > 10 intCol = 1 Do Cells(intRow, intCol) = intCol * intRow intCol = intCol + 1 Loop Until intCol > 10 intRow = intRow + 1 Loop End Sub
4. Przykład wykorzystania pętli
W przykładzie z użyciem pętli stworzymy prostą bazę osób. Po stworzeniu bazy zajmiemy się analizą danych z użyciem poznanych wcześniej funkcji i możliwości VBA. Na początek stwórzmy prostą tabelę, w której naszymi kolumnami będą Liczba porządkowa, numer indeksu, data egzaminu, wynik egzaminu, ocena słowna. Dodatkowo kolumnę Liczby porządkowej wypełnijmy kolejno liczbami od 1 do 30.
Sub LoopExample() Dim intCounter As Integer Dim intColumn As Integer Dim intRow As Integer 'wstawiamy nagłówki kolumn Cells(1, 1) = "Liczba porządkowa" Cells(1, 2) = "Numer indeksu" Cells(1, 3) = "Data egzaminu" Cells(1, 4) = "Wynik egzaminu" Cells(1, 5) = "Ocena słowna" 'wypełniamy kolumnę Liczba porządkowa liczbami od 1 do 30 intCounter = 1 Do While intCounter <= 30 Cells(intRow + 2, 1) = intCounter intCounter = intCounter + 1 intRow = intRow + 1 Loop End Sub

W ten sposób uzyskaliśmy prostą tabelkę do której możemy wprowadzać dane. W następnej kolejności przy użyciu funkcji generowania liczb losowych zmodyfikujmy nasz skrypt, tak aby:
- Kolumna Numer Indeksu była wypełniona liczbami losowymi z przedział od 90000 do 100000
- Kolumna Data egzaminu była wypełniona datą z dnia dzisiejszego – 10 dni
- Kolumna Wynik egzaminu zawierała liczby losowe od 1 do 100
- Dane zawarte w kolumnie Ocena słowna powinny odnosić się do wyników w następujący sposób: wyniki od 0 do 33 otrzymują wartość „Poprawka”. Wartości od 34 do 67 otrzymują wartość „Zdał”. Wartości większe od 67 otrzymują wartość „Zdał z wyróżnieniem”.
Liczby losowe tworzymy przy wykorzystaniu funkcji RND(). Możemy w ten sposób wygenerować liczby losowe z przedziału od 0 do 1. Wylosowaną liczbę możemy zamienić na liczby całkowite używając funkcji INT(). Funkcje te są bardziej szczegółowo opisane w artykule o funkcjach matematycznych VBA. Do dzieła !
Sub LoopExample() Dim intCounter As Integer Dim intColumn As Integer Dim intRow As Integer 'wstawiamy nagłówki kolumn Cells(1, 1) = "Liczba porządkowa" Cells(1, 2) = "Numer indeksu" Cells(1, 3) = "Data egzaminu" Cells(1, 4) = "Wynik egzaminu" Cells(1, 5) = "Ocena słowna" 'wypełniamy kolumnę Liczba porządkowa liczbami od 1 do 30 intCounter = 1 Do While intCounter <= 30 Cells(intRow + 2, 1) = intCounter intCounter = intCounter + 1 intRow = intRow + 1 Loop 'wypełniamy kolumnę numer indeksu intCounter = 1 'do licznika przypisujemy wartość 1 intRow = 0 'do licznika wierszy przypisujemy wartość początkową Do While intCounter <= 30 Cells(intRow + 2, 2) = Int(90000 + Rnd() * 10000) 'Całkowita liczba losowa od 90kdo 100k intCounter = intCounter + 1 intRow = intRow + 1 Loop 'wypełniamy kolumnę data egzaminu intCounter = 1 'do licznika przypisujemy wartość 1 intRow = 0 'do licznika wierszy przypisujemy wartość początkową Do While intCounter <= 30 Cells(intRow + 2, 3) = Date - 10 ' wstawiamy datę w 3 kolumnę intCounter = intCounter + 1 intRow = intRow + 1 Loop 'wypełniamy kolumnę wynik egzaminu intCounter = 1 'do licznika przypisujemy wartość 1 intRow = 0 'do licznika wierszy przypisujemy wartość początkową Do While intCounter <= 30 Cells(intRow + 2, 4) = Int(Rnd() * 100) 'mnożymy liczbę losową przez 100 i zaokrąglamy intCounter = intCounter + 1 intRow = intRow + 1 Loop 'wypełniamy ocenę słowną Dim StrResult As String 'wstawiamy zmienną reprezentującą oceną słowną intCounter = 1 'do licznika przypisujemy wartość 1 intRow = 0 'do licznika wierszy przypisujemy wartość początkową Do While intCounter <= 30 'instrukcja warunkowa przypisuje wynik słowny na podstawie pkt. z kolumny Wynik If Cells(intRow + 2, 4) <= 33 Then StrResult = "Poprawka" ElseIf Cells(intRow + 2, 4) > 33 And Cells(intRow + 2, 4) <= 67 Then StrResult = "Zdał" ElseIf Cells(intRow + 2, 4) > 67 Then StrResult = "Zdał z wyróżnieniem" End If Cells(intRow + 2, 5) = StrResult intCounter = intCounter + 1 intRow = intRow + 1 Loop End Sub
Plik z rozwiązaniem zadania zamieszczam poniżej:
5. Zadania (Rozwiązanie możesz wpisać w komentarzu)
5.1 Stwórz tabliczkę mnożenia z wykorzystaniem pętli Do While Loop.
5.2 Przy użyciu pętli wylistuj w arkuszu wszystkie liczby parzyste od 0 do 100.
5.3 Przy użyciu pętli wylistuj wszystkie liczby z zakresu od 0 do 100 podzielne przez 4.
5.4 Zmodyfikuj przykład z bazą osób dodając kolor w kolumnie nr 5. W zależności od wyniku egzaminu wynikowi Zdał odpowiada kolor żółty, wynikowi poprawka kolor czerwony. Dla wyniku Zdał z wyróżnieniem przypisz kolor zielony.
11 komentarzy “Pętla Do Loop w Excel VBA”
zadanie 2 proszę:
Option Explicit
Sub PetlaPrzyklad()
'pętla wyświetlająca liczby parzyste od 0 do 100 w arkuszu
Dim intLicznik As Integer
intLicznik = 0
While intLicznik <= 50
Cells(intLicznik + 1, 1) = intLicznik * 2
intLicznik = intLicznik + 1
Wend
End Sub
Zad 2.
Sub ListowanieParzyste()
Dim intRow As Integer
Dim intVal As Integer
intRow = 1
intVal = 0
Do Until intVal > 100
Cells(intRow, 1) = intVal
intRow = intRow + 1
intVal = intVal + 2
Loop
End Sub
Zad 3.
Sub ListowanieDzielnePrzez4()
Dim intRow As Integer
Dim intVal As Integer
intRow = 1
intVal = 4
Do Until intVal > 100
Cells(intRow, 1) = intVal
intRow = intRow + 1
intVal = intVal + 4
Loop
End Sub
Sub Loop4()
Dim intRow As Integer
Dim intLicznik As Integer
intRow = 1
intLicznik = 1
Do While intLicznik <= 100
If intLicznik Mod 4 = 0 Then
Cells(intRow, 1) = intLicznik
intRow = intRow + 1
Else
End If
intLicznik = intLicznik + 1
Loop
End Sub
Mam pytanie odnośnie tabliczki mnożenia. Dlaczego jeśli zadeklarujemy intCol=1 przed wejściem do pierwszej pętli to wyświetla się tylko pierwszy wiersz mnożenia?
5.1
Option Explicit
Sub LoopZadanie5_1()
Dim intRow As Integer
Dim intCol As Integer
intRow = 1
intCol = 1
Do While intRow <= 10
Do While intCol <= 10
Cells(intRow, intCol) = intRow * intCol
intCol = intCol + 1
Loop
intRow = intRow + 1
intCol = 1
Loop
End Sub
5.2
Option Explicit
Sub LoopZadanie5_2()
Dim intCounter As Integer
Dim intRow As Integer
intCounter = 0
intRow = 1
Do While intCounter <= 100
Cells(intRow, 1) = intCounter
intCounter = intCounter + 2
intRow = intRow + 1
Loop
End Sub
5.3
Option Explicit
Sub LoopZadanie5_3()
Dim intCounter As Integer
Dim intRow As Integer
intRow = 1
intCounter = 4
Do While intCounter <= 100
Cells(intRow, 1) = intCounter
intRow = intRow + 1
intCounter = intCounter + 4
Loop
End Sub
5.4
Option Explicit
Sub LoopZadanie5_4()
Dim intCounter As Integer
Dim intColumn As Integer
Dim intRow As Integer
'Nagłówki tabeli
Cells(1, 1) = „Liczba porządkowa”
Cells(1, 2) = „Numer indeksu”
Cells(1, 3) = „Data egzaminu”
Cells(1, 4) = „Wynik egzaminu”
Cells(1, 5) = „Ocena słowna”
intCounter = 1
intColumn = 1
'Ustawienie liczb porządkowych
Do While intCounter <= 30
Cells(intRow + 2, 1) = intCounter
intCounter = intCounter + 1
intRow = intRow + 1
Loop
'przypisanie wartości początkowych zmiennym DIM
intCounter = 1
intRow = 0
'wypełnienie numerów indeksu losowymi liczbami
Do While intCounter < Application.WorksheetFunction.CountA(Range(„A:A”))
Cells(intRow + 2, 2) = Int(90000 + Rnd() * 10000)
intCounter = intCounter + 1
intRow = intRow + 1
Loop
'ustawienie parametrów początkowych zmiennych DIM
intCounter = 1
intRow = 0
'Wpisanie daty egzaminu
Do While intCounter < Application.WorksheetFunction.CountA(Range(„A:A”))
Cells(intRow + 2, 3) = Date – 10
intCounter = intCounter + 1
intRow = intRow + 1
Loop
'ustawiamy początkowe wartości parametrów
intCounter = 1
intRow = 0
'generujemy losowy wynik egzaminu dla danego numeru indeksu
Do While intCounter < Application.WorksheetFunction.CountA(Range(„A:A”))
Cells(intRow + 2, 4) = Int(Rnd() * 100)
intCounter = intCounter + 1
intRow = intRow + 1
Loop
'ustawiamy wartości początkowe parametrówł
intCounter = 1
intRow = 0
'przypisujemy słowna ocenę wyniku egzaminu
Do While intCounter < Application.WorksheetFunction.CountA(Range(„A:A”))
If Cells(intRow + 2, 4) <= 33 Then
Cells(intRow + 2, 5) = „Poprawka”
ElseIf Cells(intRow + 2, 4) >= 34 And Cells(intRow + 2, 4) <= 67 Then
Cells(intRow + 2, 5) = „Zdał”
ElseIf Cells(intRow + 2, 4) > 67 Then
Cells(intRow + 2, 5) = „Zdał z wyróżnieniem”
End If
intCounter = intCounter + 1
intRow = intRow + 1
Loop
'ustawiamy wartości początkowe parametrówł
intCounter = 1
intRow = 0
'przypisujemy kolory do wyniku egzaminu
Do While intCounter < Application.WorksheetFunction.CountA(Range(„A:A”))
If Cells(intRow + 2, 4) <= 33 Then
Cells(intRow + 2, 5).Select
With Selection
.Interior.Color = vbRed
End With
ElseIf Cells(intRow + 2, 4) >= 34 And Cells(intRow + 2, 4) <= 67 Then
Cells(intRow + 2, 5).Select
With Selection
.Interior.Color = vbYellow
End With
ElseIf Cells(intRow + 2, 4) > 67 Then
Cells(intRow + 2, 5).Select
With Selection
.Interior.Color = vbGreen
End With
End If
intCounter = intCounter + 1
intRow = intRow + 1
Loop
End Sub
Sub Parzyste()
Dim intLicznik As Integer
intLicznik = 1
Do Until (intLicznik * 2) > 100
Cells(intLicznik, 1) = intLicznik * 2
intLicznik = intLicznik + 1
Loop
End Sub
Cześć,
czy wykorzystanie pętli mogłoby przyśpieszyć działanie mojego kodu?
Stworzyłam kod w wykorzystaniem Vlookup, powtarzany 3krotnie, niestety excel mieli to kilka lub nawet kilkanaście minut.
jest jakiś sposób, żeby przyśpieszyć działanie makro?
Z góry dzięki wielkie za pomoc!
On Error Resume Next
Dim Dept_Row As Long
Dim dept_Clm As Long
Table1 = ActiveSheet.Range(„i1:i” & Cells(Rows.Count, 9).End(xlUp).Row)
Table2 = Sheets(arkuszpast).Range(„i:t”)
Dept_Row = ActiveSheet.Range(„R1”).Row
dept_Clm = ActiveSheet.Range(„R1”).Column
For Each cl In Table1
ActiveSheet.Cells(Dept_Row, dept_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 10, False)
ActiveSheet.Cells(Dept_Row, dept_Clm + 1) = Application.WorksheetFunction.VLookup(cl, Table2, 11, False)
ActiveSheet.Cells(Dept_Row, dept_Clm + 2) = Application.WorksheetFunction.VLookup(cl, Table2, 12, False)
Dept_Row = Dept_Row + 1
Next cl
Ostatnie trochę przerobione co do skali ocen.
Sub tabliczkamnozenia()
Dim iNtrow As Integer
Dim iNtcolumn As Integer
iNtrow = 1
iNtcolumn = 1
Do Until iNtcolumn = 11
Do Until iNtrow = 11
Cells(iNtrow, iNtcolumn).Value = iNtrow * iNtcolumn
iNtrow = iNtrow + 1
Loop
iNtcolumn = iNtcolumn + 1
iNtrow = 1
Loop
End Sub
zad. 1
zad. 2
zad. 3
zad. 4
Witam,
Dla zadanie 4 skumulowałem wypełnianie wszystkich kolumn do jednej pętli jak poniżej.
Wstawianie odzielnej pętli dla tego samego warunku i różnego stopnia skomplikowania wykonywanych czynnościach jest bardziej przejrzyste i tego nie neguję. Zwłaszcza jest to przydatne przy bardzo skomplikowanym kodzie czynności jakie należy wykonać. Lecz czy skumulowanie wszystkich czynności w jednej pętli o tym samym warunku wpływa na szybkość makra?
Sub Zadanie_4()
Dim intCounter As Integer
Dim intColumn As Integer
Dim intRow As Integer
Dim strResult As String
Cells(1, 1) = „Liczba porządkowa”
Cells(1, 2) = „Numer indeksu”
Cells(1, 3) = „Data egzaminu”
Cells(1, 4) = „Wynik egzaminu”
Cells(1, 5) = „Ocena słowna”
intCounter = 1
Do While intCounter <= 30
Cells(intRow + 2, 1) = intCounter 'kolumna liczba porządkowa: liczbami od 1 do 30
Cells(intRow + 2, 2) = Int(90000 + Rnd() * 10000) ’ kolumna numer indeksu: całkowita liczba losowa od 90 do 100 tys
Cells(intRow + 2, 3) = Date – 10 'kolumna data egzaminu: wstawiamy datę
Cells(intRow + 2, 4) = Int(Rnd() * 100) 'kolumna wynik egzaminu: mnożymy liczbę losową przez 100 i zaokrąglamy
If Cells(intRow + 2, 4) <= 33 Then 'kolumna ocena słowna
strResult = „Poprawka”
Cells(intRow + 2, 5).Select
Selection.Interior.Color = vbRed
ElseIf Cells(intRow + 2, 4) > 33 And Cells(intRow + 2, 4) <= 67 Then
strResult = „Zdał”
Cells(intRow + 2, 5).Select
Selection.Interior.Color = vbYellow
ElseIf Cells(intRow + 2, 4) > 67 Then
strResult = „Zdał z wyróżnieniem”
Cells(intRow + 2, 5).Select
Selection.Interior.Color = vbGreen
End If
Cells(intRow + 2, 5) = strResult
intCounter = intCounter + 1
intRow = intRow + 1
Loop
End Sub