Dzisiaj stworzysz makra, które będą pozwalały scalić lub rozcalić odpowiednie komórki, dzięki czemu automatycznie będziesz mógł przekonwertować komórki na scalone, lub szybko pozbędziesz się scalonych komórek (np. żeby zrobić tabelę przestawną).
Najszybciej pokaże to poniższy rysunek:

Lewa tabelka przyda się do wszelkich analiz, formatowania, tabel przestawnych. Prawa tabelka przyda się jeśli będziesz chciał wydrukować dane lub w elegancki sposób przesłać jakiś raport.
Jeszcze jeden warunek. Żeby nasze makro było uniwersalne zróbmy, by działało tylko na ZAZNACZONYCH komórkach.
Rozdzielanie komórek
Do dzieła! Zacznijmy od rozcalania / rozdzielania ( czyli z lewej na prawą).
Do uzyskania zamierzonego efektu wystarczy makro implementujące prosty algorytm:
1. Ustaw się na pierwszej komórce w zaznaczeniu.
2. Jeśli jest wypełniona to zapamiętaj czym jest wypełniona
3. Jeśli jest pusta, to wpisz to co poprzednio zapamiętałeś
4. Przejdź do następnej komórki i wróć do punktu 2.
Implementacją tego będzie prosta procedura:
Sub rozcalZaznaczenie()
Selection.UnMerge ' usuwa scalenie z zaznaczonych komórek
' pozostało jeszcze uzupełnić puste komórki:
Dim komorka As Range ' definiujemy zmienną komórka
Dim poprzednia ' tu będziemy zapamiętywać poprzednią komórkę
'pętla:
For Each komorka In Selection ' Dla każdej komórki w zaznaczeniu:
If komorka = "" Then ' jeśli komórka jest pusta
komorka = poprzednia ' wpisz to co poprzednio zapamiętałeś
Else ' w przeciwnym przypadku, czyli jeśli komórka jest wypełniona
poprzednia = komorka ' to zapamiętaj zawartość komórki, bo
'może się przydać do wypełnienia następnej komórki
End If
Next komorka ' przejdź do następnej komórki
End Sub ' koniec procedury
starałem się wszystko opisać w komentarzach.
Scalanie komórek
Teraz chcielibyśmy uzyskać efekt odwrotny. Mamy dużo komórek, które nie są scalone, ale powtarzające się komórki ustawione są koło siebie ( np. poprzez sortowanie).
Najprostrzy algorytm będzie działał w ten sposób:
1. Zapamiętaj pierwszą komórkę z zaznaczenia na nazwie P
2. Ustaw się na pierwszej komórce w zaznaczeniu.
3. Jeśli komórka jest taka sama co komórka P to przejdź do pkt. 2.
4. Jeśli komórka różni się od komórki P (to znaczy, że skończył się blok, trzeba scalić komórki), to:
a) scal komórki powyżej naszej komórki aż do P
b) aktualną komórkę zapamiętaj jako P
c) idź do pkt 2.
Implementacja:
Sub scalanie()
Dim P As Range ' deklaracja zmiennej P
Dim komorka As Range ' deklaracja komórki
Set P = Selection.Cells(1, 1) ' zapamiętaj pierwszą komórkę z zaznaczenia
For Each komorka In Selection ' dla każdej komórki w zaznaczeniu
If komorka <> P Then ' jeśli komórka jest inna niż P
Range(komorka.Offset(-1, 0), P).Merge ' scal powyżej komórki do P
Set P = komorka ' zapamiętaj komórkę
End If
Next komorka ' przejdź do następnej komórki
End Sub
Jest prawie dobrze, ale…
Nie do końca działa tak jak chcemy.
Po pierwsze przed każdym scaleniem pojawiają się alerty / komunikaty: „Czy na pewno chcesz scalić komórki?”. Fajnie byłoby, żeby Excel nie pytał się nas o wszystko;)
W tym celu użyjemy polecenia:
Application.DisplayAlerts = False ' wyłączenie komunikatów
Po wykonaniu naszego makra warto byłoby włączyć z powrotem alerty / komunikaty:
Application.DisplayAlerts = True ' włączenie komunikatów
Zauważyłeś pewnie, że makro nie działa dla ostatniej sekcji ( dla ostatniego miasta). To dlatego, że scalamy zawsze komórki powyżej aktualnie przetwarzaną i w ten sposób makro kończy się na komórce która powinna być scalona, ale nie zdąży już jej scalić.
Jednym z pomysłów jest zaznaczać zakres z komórką o jeden niżej.
Drugim : Po co masz pamiętać, żeby zaznaczać komórkę o jedną więcej, jak makro samo może to zrobić?
Pomocna będzie funkcja RESIZE, która potrafi zmienić rozmiar danego zakresu.
Jeśli chcesz otrzymać zakres rozpoczynający się tu gdzie nasz zakres, ale o rozmiarach 15 wierszy na 2 kolumny, to piszesz:
Selection.Resize(15, 2)
Jeśli chcesz zaznaczeni powiększyć o 1, to musimy znać poprzedni rozmiar, czyli:
Selection.Rows.Count ' liczba wierszy
Selection.Columns.Count ' liczba kolumn
Łącząc oba spostrzeżenia możesz napisać:
Selection.resize(Selection.Rows.Count + 1, 1) ' o jeden wiersz więcej
przyda się jeśli dane będą w pionie
Gdy dane będą w poziomie przyda się:
Selection.resize(1, Selection.Columns.Count + 1) ' o jedną kolumnę więcej
Zastosujemy tutaj dodatkową zmienną „zakres”:
If Selection.Rows.Count = 1 Then ' jeśli zakres w poziomie ( 1 wiersz )
Set zakres = Selection.Resize(1, Selection.Columns.Count + 1) ' to rozciągnij w poziomie
Else ' jeśli w pionie (więcej wierszy)
Set zakres = Selection.Resize(Selection.Rows.Count + 1, 1) ' to rozciągnij w pionie
End If
Cały kod będzie wyglądał tak:
Sub scalanie()
Dim P As Range ' deklaracja zmiennej P
Dim komorka As Range ' deklaracja komórki
Dim zakres As Range ' tutaj zapamiętamy nasz zakres, który chcemy przetwarzać.
Application.DisplayAlerts = False ' wyłączenie komunikatów
Set P = Selection.Cells(1, 1) ' zapamiętaj pierwszą komórkę z zaznaczenia
If Selection.Rows.Count = 1 Then ' jeśli zakres w poziomie ( 1 wiersz )
Set zakres = Selection.Resize(1, Selection.Columns.Count + 1) ' to rozciągnij w poziomie
Else ' jeśli w pionie
Set zakres = Selection.Resize(Selection.Rows.Count + 1, 1)
End If
For Each komorka In zakres ' dla każdej komórki w zaznaczeniu + komórka o jeden dalej
If komorka <> P Then ' jeśli komórka jest inna niż P
Range(komorka.Offset(-1, 0), P).Merge ' scal powyżej komórki do P
Set P = komorka ' zapamiętaj komórkę
End If
Next komorka ' przejdź do następnej komórki
Application.DisplayAlerts = True ' włączenie komunikatów
End Sub
W razie pytań, pisz śmiało w komentarzach lub na maila.
Mile widziane Like na Facebooku lub +1 na GPlus
Życzę wytrwałości w pogłębianiu wiedzy!