1. VBA Permutacje elementów zbioru
W tym artykule dowiesz się w jaki sposób za pomocą języka VBA zwrócić wszystkie permutacje elementów danego zbioru. Przykłady pokazane w artykule dotyczą zarówno permutacji z powtórzeniami jak i bez powtórzeń. Pisząc kod VBA będziemy korzystali z takich funkcjonalność VBA jak Pętle For, Tablice VBA oraz z instrukcji warunkowej VBA IF. Ostatnio zostałem poproszony przez jednego z czytelników bloga – Pana Andrzeja o pomoc w utworzeniu skryptu VBA zwracającego wszystkie permutacje elementów zbioru bez powtórzeń. Poniżej szybkie wyjaśnienie tego, czym są permutacje oraz opis jak podejść do takiego zadania.
Czym są permutacje elementów zbioru? W dużym skrócie permutacje to przekształcenia zbioru polegające na zamianie kolejności jego elementów. Dla przykładu zbiór 3 elementowy z elementami o wartościach {1, 2, 3} możemy przekształcić na 6 różnych sposobów np:
- 1, 2, 3
- 1, 3, 2
- 2, 1, 3
- 2, 3, 1
- 3, 1, 2
- 3, 2, 1
Pokazana powyżej permutacja to tzw. permutacja bez powtórzeń. Oznacza to tyle, że każdy z elementów występuje w przekształconym zbiorze tylko jeden raz. Liczba możliwych kombinacji dla zbioru n-elementowego wynosi n-silnia (n!). Tak więc liczba możliwych kombinacji dla zbioru złożonego z 3 elementów w tym wypadku wynosi 3!, a więc 6. Dla zbioru 5-elementowego liczba możliwych kombinacji do uzyskania wyniesie 5!, a więc 120.
wzór na liczbę permutacji bez powtórzeń: n!
W artykule zajmiemy się także permutacjami z powtórzeniami. Wzór możliwych kombinacji dla permutacji z powtórzeniami jest nieco bardziej skomplikowany, jednak napisanie programu jest bardzo proste, stąd zajmiemy się nim na końcu artykułu. Sam wzór na liczbę możliwych kombinacji wygląda następująco:
wzór na liczbę permutacji z powtórzeniami: n! / (a! * b! * c! … * n!)
Więcej informacji na temat permutacji możesz znaleźć pod tym adresem: wikipedia permutacje
2. Zwracanie wszystkich permutacji zbioru bez powtórzeń w VBA Excel
W VBA permutacje nie są możliwe do uzyskania za pomocą prostych metod, bądź funkcji. Jeśli działamy na zbiorze n-elementowym i chcemy uzyskać wszystkie możliwe kombinacje elementów tego zbioru powinniśmy napisać w tym celu dosyć skomplikowany kod. Dla celów ćwiczenia wynik działań będzie wyświetlany w oknie VBA Immediate Window. Docelowo wyniki będą wyświetlane w komórkach arkusza Excel. By włączyć obsługę Immediate Window w VBA przejdź do zakładki Widok i wybierz element o nazwie Immediate Window. Sam schemat kodu VBA dla permutacji bez powtórzeń wygląda następująco:
'tomaszkenig.pl
Sub PermutacjeBezPowtorzen()
Dim tablica(1 To n) As String
tablica(1) = "wartość elementu 1 "
tablica(2) = "wartość elementu 2 "
tablica(3) = "wartość elementu 3 "
(...)
tablica(n) = "wartość elementu n"
dw_tablicy = LBound(tablica)
up_tablicy = UBound(tablica)
For a = dw_tablicy To up_tablicy
For b = dw_tablicy To up_tablicy
If tablica(b) <> tablica(a) Then
For c = dw_tablicy To up_tablicy
If tablica(c) <> tablica(a) And tablica(c) <> tablica(b) Then
(...)
For c = dw_tablicy To up_tablicy
If tablica(n) <> tablica(a) And tablica(n) <> tablica(b) (...) And tablica(n-1) <> tablica(n) Then
Debug.Print tablica(a) & tablica(b) & tablica(c) & tablica(n)
End If
Next
(...)
End If
Next
End If
Next
Next
End SubOpis działania:
- W przykładzie została utworzona tablica n-elementowa o indeksach od 1 do n.
- Do każdego z pól tablicy przypisana została wartość ze zbioru
- Za pomocą funkcji LBound i Ubound zwracany jest indeks pierwszego i ostatniego elementu tablicy
- Za pomocą funkcji warunkowych IF VBA sprawdzana jest informacja, czy element nie występuje już w nowym przekształconym zbiorze, by uniknąć powtórzeń elementów
- Za pomocą zagnieżdżonych pętli For tworzymy cykl wyszukujący wszystkie możliwe permutacje
- Po każdorazowym cyklu pętli program zwraca elementy zbioru w formie okna immediate za pomocą polecenia Debug.print
- Pętla For i instrukcja warunkowa VBA IF powinny zagnieżdżać się tyle razy ile elementów jest w zbiorze
2.1 Przykład 1: Zwracanie wszystkich permutacji zbioru bez powtórzeń w VBA Excel
Ok, to był schemat. Teraz czas na przykład z jego użyciem. Plik Excel z zamieszczonymi przykładami załączony jest na końcu artykułu. Poniżej kilka wymagań, które chcemy wziąć pod uwagę przy pisaniu kodu do naszego pierwszego przykładu:
- Posiadamy zbiór 3-elementowy o elementach {X, Y, Z}
- Chcemy otrzymać wszystkie możliwe permutacje elementów zbioru bez powtórzeń elementów
- Zbiory wynikowe mają posiadać taką samą liczbę elementów, jak zbiór który chcemy przekształcić
- Wynik chcemy zwrócić w oknie Immediate Window
Poniżej kod przykładu:
'tomaszkenig.pl
Sub PermutacjeBezPowtorzenPrzyklad1()
Dim tablica(1 To 3) As String
tablica(1) = "X"
tablica(2) = "Y"
tablica(3) = "Z"
dw_tablicy = LBound(tablica)
up_tablicy = UBound(tablica)
For a = dw_tablicy To up_tablicy
For b = dw_tablicy To up_tablicy
If tablica(b) <> tablica(a) Then
For c = dw_tablicy To up_tablicy
If tablica(c) <> tablica(a) And tablica(c) <> tablica(b) Then
Debug.Print tablica(a) & tablica(b) & tablica(c)
End If
Next
End If
Next
Next
End Sub
Opis Przykładu:
- W przykładzie została utworzona tablica 3-elementowa o indeksach od 1 do 3.
- Do każdego z pól tablicy przypisana została wartość ze zbioru kolejno X, Y, Z
- Za pomocą funkcji LBound i Ubound zwróciliśmy indeksy tablicy
- Za pomocą funkcji warunkowych sprawdzana jest informacja, czy element nie występuje już w nowym przekształconym zbiorze
- Za pomocą zagnieżdżonych pętli For tworzymy cykl wyszukujący wszystkie możliwe permutacje
- Po każdorazowym cyklu pętli program zwraca elementy zbioru
2.2 Przykład 2: Zwracanie wszystkich permutacji zbioru bez powtórzeń w VBA Excel dla zbioru 8 elementowego
Zróbmy kolejny przykład. Poniżej warunki, które chcemy uwzględnić w naszym programie.
- Mamy do dyspozycji zbiór 8-elementowy o wartościach tekstowych np Polska, Niemcy, USA, Wielka Brytania, Francja, Hiszpania, Rosja, Brazylia. Liczba możliwych kombinacji będzie w tym wypadku wynosiła 8!, a więc 40320 (Nie ma przeszkód, by wykorzystać w przykładzie wartości liczbowe).
- Wyniki powinny być zwracane w arkuszu w komórkach od A1 w dół
- Chcemy zwrócić wszystkie permutacje bez powtórzeń dla zbioru bez podzbiorów
Kod przykładu VBA permutacje bez powtórzeń:
'tomaszkenig.pl
Sub PermutacjeBezPowtorzenPrzyklad2()
Dim tablica(1 To 8) As String
tablica(1) = "Polska "
tablica(2) = "Niemcy "
tablica(3) = "USA "
tablica(4) = "Wielka Brytania "
tablica(5) = "Francja "
tablica(6) = "Hiszpania "
tablica(7) = "Rosja "
tablica(8) = "Brazylia "
'licznik pętli w wierszach arkusza
Dim longCounter As Long
longCounter = 1
dw_tablicy = LBound(tablica)
up_tablicy = UBound(tablica)
For a = dw_tablicy To up_tablicy
For b = dw_tablicy To up_tablicy
If tablica(b) <> tablica(a) Then
For c = dw_tablicy To up_tablicy
If tablica(c) <> tablica(a) And tablica(c) <> tablica(b) Then
For d = dw_tablicy To up_tablicy
If tablica(d) <> tablica(a) And tablica(d) <> tablica(b) And tablica(d) <> tablica(c) Then
For e = dw_tablicy To up_tablicy
If tablica(e) <> tablica(a) And tablica(e) <> tablica(b) And tablica(e) <> tablica(c) And tablica(e) <> tablica(d) Then
For f = dw_tablicy To up_tablicy
If tablica(f) <> tablica(a) And tablica(f) <> tablica(b) And tablica(f) <> tablica(c) And tablica(f) <> tablica(d) And tablica(f) <> tablica(e) Then
For g = dw_tablicy To up_tablicy
If tablica(g) <> tablica(a) And tablica(g) <> tablica(b) And tablica(g) <> tablica(c) And tablica(g) <> tablica(d) And tablica(g) <> tablica(e) And tablica(g) <> tablica(f) Then
For h = dw_tablicy To up_tablicy
If tablica(h) <> tablica(a) And tablica(h) <> tablica(b) And tablica(h) <> tablica(c) And tablica(h) <> tablica(d) And tablica(h) <> tablica(e) And tablica(h) <> tablica(f) And tablica(h) <> tablica(g) Then
' Debug.Print tablica(a) & tablica(b) & tablica(c) & tablica(d) & tablica(e) & tablica(f) & tablica(g) & tablica(h)
Cells(longCounter, 1) = tablica(a)
Cells(longCounter, 2) = tablica(b)
Cells(longCounter, 3) = tablica(c)
Cells(longCounter, 4) = tablica(d)
Cells(longCounter, 5) = tablica(e)
Cells(longCounter, 6) = tablica(f)
Cells(longCounter, 7) = tablica(g)
Cells(longCounter, 8) = tablica(h)
longCounter = longCounter + 1
End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
Next
End Sub
Opis Przykładu:
- W przykładzie została utworzona tablica 8-elementowa o indeksach od 1 do 8.
- Do każdego z pól tablicy przypisana została wartość ze zbioru oznaczająca nazwę państwa
- Za pomocą funkcji LBound i Ubound zwróciliśmy indeksy tablicy
- Utworzony został licznik kolejnej pętli LongCounter do celów obsługi arkusza Excel
- Za pomocą funkcji warunkowych sprawdzana jest informacja, czy element nie występuje już w nowym przekształconym zbiorze
- Za pomocą zagnieżdżonych pętli For tworzymy cykl wyszukujący wszystkie możliwe permutacje
- Po każdorazowym cyklu pętli program zwraca elementy zbioru do kolejnych kolumn arkusza z wykorzystaniem licznika LongCounter
- Po każdorazowym cyklu pętli następuje zwiększenie wartości licznika LongCounter o 1, by dodawać dane do kolejnych wierszy
3. VBA Permutacja elementów zbioru z powtórzeniami
Permutacje w VBA z powtórzeniami, choć z pozoru wydają się trudniejsze, możemy stworzyć w bardzo prosty sposób. Jedyne co powinieneś zrobić w porównaniu do poprzednich przykładów to usunąć wszystkie instrukcje warunkowe zagnieżdżone w pętach For z powyższych przykładów. Tak więc, jeśli chcesz otrzymać permutacje zbioru np 3-elementowego z powtórzeniami kod możesz zapisać w następujący sposób:
'tomaszkenig.pl Sub PermutacjeZPowtorzeniamiPrzyklad3() Dim tablica(1 To 3) As String tablica(1) = "A" tablica(2) = "B" tablica(3) = "C" dw_tablicy = LBound(tablica) up_tablicy = UBound(tablica) For i = dw_tablicy To up_tablicy For j = dw_tablicy To up_tablicy For k = dw_tablicy To up_tablicy Debug.Print tablica(i) & tablica(j) & tablica(k) Next Next Next End Sub
Wyżej załączony przykład zwraca zbiory w oknie immediate. Poniżej analogiczny przykład zwracający zbiory do komórek arkusza. Obydwa przykłady są modyfikacją przykładów z punktu 2 tego artykułu.
'tomaszkenig.pl Sub PermutacjeZPowtorzeniamiPrzyklad4() Dim tablica(1 To 3) As String tablica(1) = "A" tablica(2) = "B" tablica(3) = "C" 'licznik pętli w wierszach arkusza Dim longCounter As Long longCounter = 1 dw_tablicy = LBound(tablica) up_tablicy = UBound(tablica) For i = dw_tablicy To up_tablicy For j = dw_tablicy To up_tablicy For k = dw_tablicy To up_tablicy Cells(longCounter, 1) = tablica(i) Cells(longCounter, 2) = tablica(j) Cells(longCounter, 3) = tablica(k) longCounter = longCounter + 1 Next Next Next End Sub
Plik z wszystkimi omawianymi przykładami zamieszczam poniżej:
Podobne przykłady praktycznego użycia języka VBA w Excelu zamieszczam na tej stronie: Makra Przykłady. Przy okazji zapraszam do przejścia kursu VBA mojego autorstwa, znajdziesz go pod tym linkiem: VBA
