VBA - PROGRAMMIERUNG -  ARRAY-DIMENSIONEN

 Option Explicit
' Test-Arrays
Dim Arrays1() ' unbestimmtes Array - 0D
Dim Arrays2(4, 5, 6) ' 210 Elemente - 3D
Dim Arrays3(-2 To 2, 1 To 4) ' 20 Elemente - 2D
Dim Arrays4(2, 2, 2, 2) ' 81 Elemente - 4D

Sub ArrayAufruf()
Arrays2(1, 2, 3) = 4
Arraystest Arrays1()
Arraystest Arrays2()
Arraystest Arrays3()
Arraystest Arrays4()
End Sub

Sub Arraystest(Arrays())
Dim i ' Schleife
Dim Anzahl, AAnzahl, GAnzahl ' Anzahlen der Array-Elemente
On Error GoTo FehlerBehandlung
For i = 1 To 10
    Anzahl = UBound(Arrays, i)
    'Debug.Print Anzahl
Next i
ArraysTestFortsetzung:
Anzahl = i - 1 'Anzahl der Dimensionen
Debug.Print "Anzahl der Dimensionen = " & Anzahl
GAnzahl = 0 ' Gesamtanzahl der Elemente auf 0
For i = 1 To Anzahl
    Debug.Print " " & i & ". Dimension: " & LBound(Arrays, i) & _
        " bis " & UBound(Arrays, i)
    AAnzahl = AnzahlArrayElemente(LBound(Arrays, i), UBound(Arrays, i))
    Debug.Print " Anzahl der Elemente = " & AAnzahl
    GAnzahl = IIf(i = 1, 1, GAnzahl) * AAnzahl
Next i
Debug.Print " Gesamtanzahl der Elemente = " & GAnzahl
Debug.Print "====================================="
Exit Sub
FehlerBehandlung:
' dieser Programmteil wird aufgerufen, sobald in der Schleife auf
' eine nicht vorhandene Arraysdimension zugegriffen wird
Resume ArraysTestFortsetzung
End Sub

Public Function AnzahlArrayElemente(UGrenze As Long, OGrenze As Long) As Long
' ermittelt die Anzahl der Elemente eines Arrays von dem Ober- und
' Untergrenze ermittelt und übergeben wurden

' Fall-Beispiel: ArrayX(5), ArrayX(5 To 10)
If OGrenze >= 0 And UGrenze >= 0 And OGrenze > UGrenze Then
    AnzahlArrayElemente = OGrenze - UGrenze + 1
End If
' Fall-Beispiel: ArrayX(-5 To -10)
If OGrenze < 0 And UGrenze < 0 And OGrenze < UGrenze Then
    AnzahlArrayElemente = -OGrenze + UGrenze + 1
End If
' Fall-Beispiel: ArrayX(-5 To 5)
If OGrenze >= 0 And UGrenze < 0 And OGrenze > UGrenze Then
    AnzahlArrayElemente = OGrenze - UGrenze + 1
End If
End Function