Sortowanie alfabetyczne arkuszy

Kilkukrotnie spotkałem się ze skoroszytami składającymi się z dziesiątek, wręcz setek arkuszy. W kilku przypadkach autorzy tego typu skoroszytów mieli problem z utrzymaniem układu arkuszy w porządku alfabetycznym (na czym bardzo im zależało). Prosty kod VBA potrafi wykonać tą operację w... ułamku sekundy. Prezentując metody sortowania arkuszy chciałbym jednak zwrócić uwagę na umiejętność wykorzystania technik arkuszowych w celu przyspieszenia tego typu rozwiązania.

Podejście 1. 
Problem sortowania czegokolwiek to szerokie zagadnienie. Możemy zastosować kilka różnych metod sortujących zależnie od sytuacji. Wyobraźmy sobie jednak, że nie znamy się na sortowaniu bąbelkowym, zliczającym, itp.,  ale potrafimy stworzyć prosty mechanizm logiczny, który ujmę w następujący algorytm:

a. dla kolejnych arkuszy sprawdź, czy arkusz następny nie powinien być przed arkuszem sprawdzanym
b. jeżeli tak to arkusz następny przenieś przed arkusz sprawdzany
c. rozpocznij weryfikację od początku

Rozwiązanie powyższe przedstawia prosty poniższy kod:

view sourceprint?

01	Sub Sortowanie_Attempt_1st()

02

03	Application.ScreenUpdating = False

04

05	Dim iSH As Integer

06

Powtórz:

07	For iSH = 2 To Sheets.Count

08	If Sheets(iSH - 1).Name < Sheets(iSH).Name Then

09	Sheets(iSH).Move Sheets(iSH - 1)

10	GoTo Powtórz

11

End If

12

Next iSH

13

14	Application.ScreenUpdating = False

15

16

End Sub

Podejście 2.
Jedną z najbardziej wydajnych technik sortowania jest ta, która znamy z procesu sortowanie komórek. W tym podejściu wykorzystamy tą technikę. Kolejne kroki algorytmu to:

a. utworzymy tymczasowy arkusz i zapiszemy do niego nazwy wszystkich arkuszy naszego skoroszytu
b. posortujemy listę uzyskaną w powyższym kroku
c. kolejno ułożymy arkusze w porządku zgodnym z posortowaną listą z punktu b
d. a na koniec wykasujemy nasz tymczasowy arkusz z punktu a.

Powyższy algorytm prezentuje poniższy kod. Z pewnością na pierwszy rzut oka widać różnicę w długości kodu. Proszę jednak zapoznać się z podsumowaniem na końcu niniejszego postu.

view sourceprint?

01	Sub Sortowanie_Attempt_2nd()

02

03	Application.ScreenUpdating = False

04	If Sheets.Count < 2 Then Exit Sub

05

06

'a)

07	Dim tmpSH As Worksheet

08	Set tmpSH = Sheets.Add

09

10	Dim SH As Worksheet

11	Dim i As Long

12	For Each SH In Sheets

13

i = i + 1

14	tmpSH.Cells(i, 1) = SH.Name

15

Next

16

17

'b)

18	tmpSH.Range("A1").CurrentRegion.Sort tmpSH.Range("A1")

19

20

'c)

21	For i = 1 To tmpSH.Range("A1").CurrentRegion.Cells.Count - 1

22	Sheets(tmpSH.Cells(i + 1, 1).Value).Move , _

23	Sheets(tmpSH.Cells(i, 1).Value)

24

Next i

25

26

'd)

27	Application.DisplayAlerts = False

28	tmpSH.Delete

29	Application.DisplayAlerts = True

30	Application.ScreenUpdating = False

31

32

End Sub

Podsumowanie.
Powyższe dwie procedury są doskonałym sposobem na porównanie wydajności różnych technik. Choć wydaje się, że wykonując znacznie więcej kroków w podejściu 2 kod może wykonywać się dłużej to wcale tak nie jest. Otóż procedura 2 pozwala na wykonanie zadania w czasie około 5-7 razy krótszym niż wariant 1.

Ciekawostka.
Gdybyśmy chcieli zmienić kolejność sortowania na malejące to w obu zaprezentowanych wariantach wystarczy dosłownie wstawić lub zamienić po jednym znaku:

a. w Podejściu 1 o kierunku sortowania decyduje znak >< porównujący nazwy arkuszy
b. w Podejściu 2 o kierunku sortowania decyduje obecność lub brak pojedynczego przecinka co prezentują poniższe linie kodu:

view sourceprint?

1	'sortowanie rosnące

2	Sheets(tmpSH.Cells(i + 1, 1).Value).Move , Sheets(tmpSH.Cells(i, 1).Value)

3	'sortowanie malejące

4	Sheets(tmpSH.Cells(i + 1, 1).Value).Move Sheets(tmpSH.Cells(i, 1).Value)