Korzystanie z pętli należy do abecadła programowania bez względu na język, w którym kodujemy. Jednymi z bardziej popularnych konstrukcji są Do While i Do Until. Obie pętle są do siebie bardzo podobne, ale odróżnia je sposób określenia warunku.
Typy pętli w VBA
W VBA najbardziej popularną pętlą jest prawdopodobnie For Next. Sprawdza się ona doskonale, gdy chcemy np. sprawdzić wszystkie elementy tablicy.
Nieco rzadziej możemy zobaczyć w makrach konstrukcję For Each. Służy ona do wykonywania operacji na poszczególnych obiektach kolekcji.
Nieco mniej popularne są pętle typu Do While i Do Until, których używa się wtedy, gdy (nie)spełniony jest konkretny warunek. Dlaczego tak się dzieje?
Obie konstrukcje w bardzo łatwy sposób można zastąpić tą najpopularniejszą For Next. Drugi powód jest taki, że konstrukcje Do While i Do Until wydają się nieco mniej intuicyjne.
Działaj, gdy – Przerwij, gdy
Zanim omówimy sobie dwa konkretne makra, ustalmy czym różni się warunek Do While od Do Until.
- Do While możemy objaśnić jako działaj, gdy – czyli działaj, wtedy gdy spełniony jest dany warunek.
- Do Until możemy objaśnić jako przerwij, gdy – czyli przerwij, wtedy gdy spełniony jest dany warunek.
Przykładowe makra
Sprawdźmy na przykładach różnice pomiędzy obiema konstrukcjami.
Pusta komórka w zakresie
Jeżeli przechodzimy w pętli po komórkach pierwszej kolumny i chcemy przerwać makro gdy natrafimy na pustą komórkę, to warunki możemy ustalić następująco.
Działaj, gdy niepusta
1 2 3 4 5 6 |
Do While Len(Arkusz1.Cells(x, "A")) <> 0 'Zrób coś x = x + 1 Loop |
W tym przypadku warunek rozumujemy tak: działaj dopóki sprawdzana komórka jest niepusta.
Przerwij, gdy niepusta
1 2 3 4 5 6 |
Do Until Len(Arkusz1.Cells(x, "A")) = 0 'Zrób coś x = x + 1 Loop |
W tym przypadku warunek rozumujemy tak: przerwij gdy natrafisz na pustą komórkę.
Test logiczny na końcu pętli
Warto jeszcze dodać, że w obu pętlach warunek możemy umieścić na samym dole. Będzie to oznaczać, że pętla zostanie uruchomiona przynajmniej jeden raz.
LOOP WHILE
1 2 3 4 5 6 |
Do 'Zrób coś x = x + 1 Loop While Len(Arkusz1.Cells(x, "A")) <> 0 |
LOOP UNTIL
1 2 3 4 5 6 |
Do 'Zrób coś x = x + 1 Loop Until Len(Arkusz1.Cells(x, "A")) = 0 |
Mnożenie x 2
Chcemy przemnożyć x2 liczby z kolumny A i wyniki wpisać do kolumny B. Makro powinno skończyć swój bieg, gdy natrafi na pustą komórkę. W tym celu wykorzystamy pętlę Do While.
Wynik działania makra
Efekt działania makra PrzemnozPrzezDwa pokazuje poniższy screen.

Kod makra. Pętla Do While.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
Private Const msMODUL As String = "MPetleDoWhileDoWhile" Option Explicit Public Sub PrzemnozPrzezDwa() '// Makro przechodzi w pętli przez wszystkie liczby z kolumny A. '// W kolumnie obok wstawia liczbę dwukrotnie większą. '// Uwaga! Makro przerywa bieg, gdy trafi na pustą komórkę. Dim lMojaLiczba As Long 'Liczba z kolumny A Dim lWynikMnozenia As Long 'Wynik - moja liczba * 2 Dim x As Long 'Licznik Const sPROC As String = "PrzemnozPrzezDwa" 'Aktywuj obsługę błędów na starcie 1 On Error GoTo ObslugaBledu 'Ustaw licznik na 1 2 x = 1 'Przerwij gdy natrafisz na pustą komórkę 3 Do While Len(Arkusz1.Cells(x, "A")) <> 0 'Zaczytaj liczbę z komórki A 4 lMojaLiczba = Arkusz1.Cells(x, "A") 'Przemnóż liczbę i zaczytaj jej wynik do zmiennej 5 lWynikMnozenia = lMojaLiczba * 2 'Zaczytaj wynik mnożenia do komórki obok 6 Arkusz1.Cells(x, "B") = lWynikMnozenia 'Zwiększ licznik 7 x = x + 1 8 Loop 'Kontynuuj działanie pętli Wyjscie: 9 On Error GoTo 0 10 Exit Sub ObslugaBledu: 11 Application.ScreenUpdating = True 12 MsgBox "Wystąpił błąd nr " & Err.Number & " (" & Err.Description & ")." & _ vbCr & vbCr & "Linia kodu nr " & Erl & " w procedurze " & _ "'" & sPROC & "' modułu '" & msMODUL & "'.", vbInformation, "BŁĄD!" 13 Resume Wyjscie End Sub |
Pętla po plikach w katalogu
Tym razem chcemy przejść w pętli tylko po plikach XLSX, które zawierają raporty za dany miesiąc. Nie wiemy ile ich jest. Operujemy na katalogu Kwerendy.
Celem makra jest wynotowanie w okienku Immediate nazw wszystkich plików XLSX. Na potrzeby wpisu nie kombinujemy za bardzo, ale w praktyce możemy np. przetworzyć każdy raport.
Przerywamy warunek gdy funkcja Dir zwróci w wyniku pusty ciąg. Nie będzie ona wtedy mogła już przejść do następnego pliku. Wykorzystujemy pętlę Do Until.
Efekt działania kodu


Kod makra. Pętla Do Until.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
Private Const msMODUL As String = "MPetleDoWhileDoUntil" Option Explicit Public Sub ZaczytajDaneZRaportowMc() ' Makro przechodzi po plikach XLSX. Są to kwerendy z danymi miesięcznymi. ' Nie wiemy ile plików znajduje się w katalogu, więc korzystamy z Dir(). Dim sPlikXLSX As String 'Nazwa pojedynczego pliku XLSX Const sPROC As String = "ZaczytajDaneZRaportowMc" 'Lokalizacja katalogu głównego - stała Const sKATALOG_GLOWNY As String = _ "F:\Moje pliki\Blog\Pętla DoWhile i DoUntil\Kwerendy" 'Aktywuj obsługę błędów na starcie 1 On Error GoTo ObslugaBledu 'Zaczytaj do zmiennej nazwę pierwszego pliku 2 sPlikXLSX = Dir(sKATALOG_GLOWNY & "\" & "*.xlsx") 'Przerwij gdy nie można pobrać nazwy pliku 3 Do Until Len(sPlikXLSX) = 0 'Wypisz nazwę pliku XLSX w okienku Immediate 4 'Debug.Print sPlikXLSX 'Przypisz zmienną sPlikXLSX do następnego pliku 5 sPlikXLSX = Dir() 6 Loop 'Kontynuuj działanie pętli Wyjscie: 7 On Error GoTo 0 8 Exit Sub ObslugaBledu: 9 Application.ScreenUpdating = True 10 MsgBox "Wystąpił błąd nr " & Err.Number & " (" & Err.Description & ")." & _ vbCr & vbCr & "Linia kodu nr " & Erl & " w procedurze " & _ "'" & sPROC & "' modułu '" & msMODUL & "'.", vbInformation, "BŁĄD!" 11 Resume Wyjscie End Sub |