Pro informace o výuce Excelu klikněte zde

V návodu na odstranění netisknutelých znaků v oblasti jsem ukázal jak efektivní a rychlé může být zpracování hodnot v poli.
Tady tuto techniku rozepíšu o trochu vice.

1. Načtení oblasti do 2Dpole

Vytvořil jsem oblast 1000 řádků a 100 sloupců (tj. 100 000 buněk) a do každé buňky v oblasti jsem vložit hodnoty.

1.1. Můžeme procházet oblast a vkládat hodnoty do pole

Sub OblastDoPole1()
Dim Pole() 'Definování dynamického pole
Dim Oblast As Range
Dim r As Long, s As Long
Dim cas As Date

cas = Timer
Set Oblast = ActiveSheet.UsedRange

'Určení velikosti pole podle oblasti
ReDim Pole(1 To Oblast.Rows.Count, 1 To Oblast.Columns.Count)

'Procházení oblasti v cyklu a vkládání hodnot do pole
For r = 1 To Oblast.Rows.Count
      For s = 1 To Oblast.Columns.Count
            'Zápis Oblast.Range("A1") vrací pravou horní buňku oblasti
            Pole(r, s) = Oblast.Range("A1").Offset(r - 1, s - 1)
      Next s
Next r

Set Oblast = Nothing
MsgBox "Oblast načtena do pole za: " & Format(Timer - cas, "0.0"), vbInformation

End Sub

Doba trvání načtení do pole za: 3,5 s.

1.2. Lepší způsob načtení oblasti do pole

Sub OblastDoPole2()
Dim Pole As Variant 'musí být typ Variant, bez závorek
Dim cas As Date

cas = Timer

'Timto způsobem získáme vždy dvourozměrné pole, spodní hranice začíná od 1
Pole = ActiveSheet.UsedRange

MsgBox "Oblast načtena do pole za: " & Format(Timer - cas, "0.0"), vbInformation

End Sub

Doba trvání na mém počítači: 0,2 s.

2. Zápis dvourozměrného pole do oblasti

Pokud vložíme oblast do pole, můžeme stejným způsobem vložit pole zpátky do oblasti.

ActiveSheet.UsedRange = Pole

Ale v mnoha případech potřebujeme upravit velikost oblasti podle velikosti pole.

Range("A1").Resize(UBound(Pole, 1) - LBound(Pole, 1) + 1, UBound(Pole, 2) - LBound(Pole, 2) + 1) = Pole

Kde:
LBound(Pole, 1) nám vrací spodní hranici prvního rozměru
LBound(Pole, 2) nám vrací spodní hranici druhého rozměru
UBound(Pole, 1) nám vrací horní hranici prvního rozměru
UBound(Pole, 2) nám vrací horní hranici druhého rozměru.
Spodní hranice nemusí začínat od nuly, proto zjišťuji hodnotu spodní hranice o odečítám od horní.
Tak dostanu univerzální zápis nezávislý na spodní hranici pole.

3. Užitečné funkce při práci s poli

Pokud pracujeme s poli, potřebujeme zjistit, zda proměnná je typu pole.

Function JePrazdnePole(Pole As Variant) As Boolean
Dim SpodniRozmer As Long
Dim HorniRozmer As Long

JePrazdnePole = True

On Error Resume Next
If Not IsArray(Pole) Then Exit Function

HorniRozmer = UBound(Pole, 1)

If Err.Number = 0 Then
      Err.Clear
      SpodniRozmer = LBound(Pole)
      'Občas se může stát,
      'že zjištění horního rozměru nám nevrátí chybu,
      'i když je pole prázdné, ale hodnotu -1
      If HorniRozmer > SpodniRozmer Then JePrazdnePole = False
End If

End Function

Zkouška funkce

Sub ZkoukaNaPrazdnePole
Dim Pole As Variant
Dim Pole2() As Variant 'Definování dynamického pole
Dim Pole3(10,2) As Variant 'Definování statického pole

Debug.Print JePrazdnePole (Pole) 'Vrátí True
Pole = Range("A1:B10")
Debug.Print JePrazdnePole (Pole) 'Vrátí False
Debug.Print JePrazdnePole (Pole2) 'Vrátí True
Debug.Print JePrazdnePole (Pole3) 'Vrátí False

End Sub

Další užitečná funkce zjišťuje počet rozměrů pole.

Function PocetRozmeruPole(Pole As Variant) As Integer
' Vrací počet rozměrů pole

Dim Pocet As Integer
Dim Velikost As Integer
On Error Resume Next
'Ve smyčce zjišťujeme počet rozměrů pole do té doby, než nastane chyba
Do
      Pocet = Pocet + 1
      Velikost = UBound(Pole, Pocet)
Loop Until Err.Number <> 0

PocetRozmeruPole = Pocet - 1

End Function

Transpozice dvourozměrného pole. Pro transpozici pole můžeme použit vestavěnou funkci Excelu Transpose.

Pole = Application.WorksheetFunction.Transpose(Pole)

Nesmíme zapomenout, že takto můžeme transponovat jen dynamicky definované pole. Pokud se takto pokusíme transponovat pole deklarované Dim Pole(0 To 10, 1 To 100) Excel vrátí chybu.
Funkce Transpose má ve starších verzích Excelu své limity, viz.: http://support.microsoft.com/default.aspx?scid=kb;en-us;177991

Pro tyto případy můžeme transponovat pole pomocí této procedury:

Sub Transponuj2DPole(Pole As Variant)
Dim tmpPole As Variant
Dim lb1 As Long, lb2 As Long, ub1 As Long, ub2 As Long
Dim r As Long, s As Long

lb1 = LBound(Pole, 1)
lb2 = LBound(Pole, 2)
ub1 = UBound(Pole, 1)
ub2 = UBound(Pole, 2)

ReDim tmpPole(lb2 To lb2 + ub2 - lb2, lb1 To lb1 + ub1 - lb1)

For r = LBound(Pole, 2) To UBound(Pole, 2)
      For s = LBound(Pole, 1) To UBound(Pole, 1)
            tmpPole(r, s) = Pole(s, r)
      Next s
Next r

Erase Pole
Pole = tmpPole
End Sub

4. Dva příklady vytvoření pole a následně hromadný zápis do buněk

Vytvoření měsíčního kalendáře podle aktuálního měsíce a následné vložení do listu

Sub vlozMesicniKalendardoListu()
Dim r As Integer, s As Integer
Dim poleDatumu(1 To 6, 1 To 7) As Date
Dim prvniDen As Date
Dim denTydne As Integer

prvniDen = DateSerial(Year(Date), Month(Date), 1)
denTydne = Weekday(prvniDen, vbMonday)
prvniDen = prvniDen - denTydne + 1

For r = 1 To 6
      For s = 1 To 7
            poleDatumu(r, s) = prvniDen
            prvniDen = prvniDen + 1
      Next s
Next r

With Range("A1").Resize(UBound(poleDatumu, 1) - LBound(poleDatumu, 1) + 1, UBound(poleDatumu, 2) - LBound(poleDatumu, 2) + 1)
      .NumberFormat = "dd.mm.yy ddd"
      .Value = poleDatumu
      .Columns.AutoFit
End With

End Sub

Vytvoření ročního kalendáře podle aktuálního roku a následné vložení do listu

Sub vlozRocniKalendardoListu()
Dim r As Integer, s As Integer
Dim poleDatumu(1 To 53, 1 To 7) As Date
Dim prvniDen As Date
Dim denTydne As Integer

prvniDen = DateSerial(Year(Date), 1, 1)
denTydne = Weekday(prvniDen, vbMonday)
prvniDen = prvniDen - denTydne + 1

For r = 1 To 53
      For s = 1 To 7
           poleDatumu(r, s) = prvniDen
           prvniDen = prvniDen + 1
      Next s
Next r

With Range("A1").Resize(UBound(poleDatumu, 1) - LBound(poleDatumu, 1) + 1, UBound(poleDatumu, 2) - LBound(poleDatumu, 2) + 1)
      .NumberFormat = "dd.mm.yy ddd"
      .Value = poleDatumu
      .Columns.AutoFit
End With

End Sub