Da ich in Access sehr viel mit Arrays arbeite habe ich mal ein Wrapperobjekt geschrieben um mir das Ding Untertan zu machen. Denn die eigentlichen Arrays taugen nix

'-------------------------------------------------------------------------------
'File         : ArrayObject
'               Copyright © by ERB software
'               All rights reserved
'Environment  : Access 2000/XP/2007
'Version      : 1.0
'Name         : ArrayObject
'Description  : Ein Wrapper umd ie VBA-Arrays
'Author       : Stefan Erb (ERS)
'History      : 08.01.2013 - ERS - Creation
'-------------------------------------------------------------------------------
Option Explicit
Option Compare Database
 
'http://www.activevb.de/tipps/vb6tipps/tipp0571.html
Private Declare Sub GetSafeArrayPointer Lib "msvbvm60.dll" Alias "GetMem4" (pArray() As Any, sfaPtr As Long)
 
 
Private vArray()    As Variant
Private vNextIndex  As Long
Private vType       As VbVarType
 
Public Enum ArrayObejctErrors
	NOT_FOUND = vbObjectError + 42
	IS_EMPTY
	NOT_INITIALIZED
	INDEX_NOT_EXISTS
	NOT_WORK_WITH_OBJECTS
End Enum
 
'------------------------------------------------------------------------------------------------
' constructors
'------------------------------------------------------------------------------------------------
 
'/**
' * erstellt ein Range-ArrayObject
' * @excample
' *             Dim numbers As New ArrayObject
' *             Set numbers = numbers.range(1, totalNumbers)
' * @param  Long    Kleinste Zahl
' * @param  Long    Höchste Zahl
' * @param  Long    Schrittgrösse
' * @return ArrayObject
' */
Public Static Function range(ByVal iLow As Long, ByVal iHigh As Long, Optional ByVal iStep As Long = 1) As ArrayObject
	Dim i As Long
 
	Set range = New ArrayObject
 
	For i = iLow To iHigh Step iStep
		Call range.add(i)
	Next i
 
	Call reset
End Function
 
 
Public Static Function split( _
		ByVal Expression As String, _
		Optional ByVal Delimiter As String, _
		Optional ByVal Limit As Long = -1, _
		Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _
) As ArrayObject
	Set split = New ArrayObject
	Set split.list = split(Expression, Delimiter, Limit, Compare)
End Function
 
 
'------------------------------------------------------------------------------------------------
' navigation
'------------------------------------------------------------------------------------------------
 
Public Property Get count() As Long
	If Not isInitialized Then Call Err.Raise(Number:=NOT_INITIALIZED, description:="The Array is not initialised", Source:="ArrayObject.count()")
	count = uBoundA - lBoundA + 1
End Property
 
Public Property Get lBoundA() As Long
	If Not isInitialized Then Call Err.Raise(Number:=NOT_INITIALIZED, description:="The Array is not initialised", Source:="ArrayObject.lBoundA()")
	lBoundA = LBound(vArray)
End Property
 
Public Property Get uBoundA() As Long
	If Not isInitialized Then Call Err.Raise(Number:=NOT_INITIALIZED, description:="The Array is not initialised", Source:="ArrayObject.uBoundA()")
	uBoundA = UBound(vArray)
End Property
 
'/**
' * Setzt den internen Zeiger zurück
' */
Public Sub reset()
	vNextIndex = 0
End Sub
 
'/**
' * Gibt auskunft ob ein nächstes Element besteht
' * @return Boolean
' */
Public Property Get hasNextItem() As Boolean
	If isEmpty Then Call Err.Raise(Number:=IS_EMPTY, description:="The Array is empty", Source:="ArrayObject.hasNextItem()")
	hasNextItem = (uBoundA >= vNextIndex)
End Property
 
'/**
' * Geht zum nächsten Element
' * @return Variant     Nächstes Element (oder NULL wenn kein weiteres Elelemtn vorhanden ist)
' */
Public Function nextItem() As Variant
	If isEmpty Then Call Err.Raise(Number:=IS_EMPTY, description:="The Array is empty", Source:="ArrayObject.nextItem()")
	If hasNextItem Then
		Call getV(vNextIndex, nextItem)
		vNextIndex = vNextIndex + 1
	Else
		nextItem = Null
	End If
End Function
 
 
'------------------------------------------------------------------------------------------------
' data manupilation
'------------------------------------------------------------------------------------------------
 
'/**
' * Fügt ein Element hinzu
' * @param  Variant     Element
' */
Public Function add(ByVal iValue As Variant) As Long
  add = redimA
  Call setV(add, iValue)
End Function
 
'/**
' * Gibt den Wert an einer bestimmten Stelle zurück
' * @param  Long        Index
' * @return Variant
' */
Public Function getValue(ByVal iIndex As Long) As Variant
	If iIndex < lBoundA Or iIndex > uBoundA Then
		Call Err.Raise(INDEX_NOT_EXISTS, "ArrayObject.setValue", "Index " & iIndex & " dosnt exists")
	End If
	Call getV(iIndex, getValue)
End Function
 
'/**
' * Ersetzt den Wert an einem bestimten Index
' * @param  Long        Index
' * @param  Variant     Element
' */
Public Sub setValue(ByVal iIndex As Long, ByVal iValue As Variant)
	If iIndex < LBound(vArray) Or iIndex > UBound(vArray) Then
		Call Err.Raise(INDEX_NOT_EXISTS, "ArrayObject.setValue", "Index " & iIndex & " dosnt exists")
	End If
	Call setV(iIndex, iValue)
End Sub
 
'/**
' * Führt einen Redim Preserve aus.
' * @param  Long    step
' * @return Long    ubound des Arrays
'*/
Public Function redimA(Optional ByVal iStep As Long = 1) As Long
  If Me.isEmpty Then
	ReDim vArray(iStep - 1)
  ElseIf uBoundA + iStep > -1 Then
	ReDim Preserve vArray(uBoundA + iStep)
  End If
  redimA = uBoundA
End Function
 
'   /**
'    * addArray
'    * @param   Array
'    */
Public Sub addArray(ByRef iArray As Variant)
	Dim i
	For i = 0 To UBound(iArray)
		Call add(iArray(i))
	Next i
End Sub
 
'   /**
'    * addArrayObject
'    * @param   ArrayObject
'    */
Public Sub addArrayObject(ByRef iArrayObject As ArrayObject)
	Call iArrayObject.reset
	Do While iArrayObject.hasNextItem
		Call add(iArrayObject.nextItem)
	Loop
End Sub
 
 
Public Function extratPart(ByVal iStart As Long, ByVal iEnd As Long) As ArrayObject
	Dim i   As Long
	Dim e   As Variant
 
	Set extratPart = New ArrayObject
	For i = getMax(iStart, lBoundA) To min(iEnd, uBoundA)
		Call getV(i, e)
		Call extratPart.add(e)
	Next i
 
End Function
'------------------------------------------------------------------------------------------------
' public methodes
'------------------------------------------------------------------------------------------------
 
'/**
' * Führt einen Join aus
' * @param  String      Trennzeichen
' */
Public Function join(ByVal Delimiter As String) As String
	If IsObject(vArray(LBound(vArray))) Then
		Call Err.Raise(NOT_WORK_WITH_OBJECTS, "ArrayObject.join()", "The function join dosnt work with Objects")
	End If
	join = Strings.join(vArray, Delimiter)
End Function
 
'/**
' * Mischt den Array. Achtung, die Indexierung geht dabei verloren
' * http://www.cpearson.com/excel/ShuffleArray.aspx
' */
Public Sub shuffle()
	Dim N As Long
	Dim Temp As Variant
	Dim J As Long
 
	For N = LBound(vArray) To UBound(vArray)
		Randomize Time
		J = CLng(((uBoundA - N) * Rnd) + N)
		If N <> J Then
			Call getV(N, Temp)
			Call setV(N, vArray(J))
			Call setV(J, Temp)
		End If
	Next N
	Call reset
End Sub
 
'/**
' * Prüft ob der Array initialisiert ist
' * http://www.activevb.de/tipps/vb6tipps/tipp0571.html
' * @return Boolean
' */
Public Property Get isInitialized() As Boolean
	Dim sfaPtr      As Long
 
	Call GetSafeArrayPointer(vArray, sfaPtr)
	isInitialized = (sfaPtr > 0)
 
'    Dim Dummy As Long
'    If IsArray(vArray) Then
'        'Ggf. Fehler provozieren:
'        On Error Resume Next
'        Dummy = LBound(vArray)
'        isInitialized = (Err.Number = 0)
'        On Error GoTo 0
'    Else
'        isInitialized = False
'    End If
End Property
 
'/**
' * Angabe ob der Array Leer oder nicht initialisiert ist
' * @return Boolean
' */
Public Property Get isEmpty() As Boolean
	If isInitialized Then
		isEmpty = (uBoundA = -1)
	Else
		isEmpty = True
	End If
End Property
 
'/**
' * Sortiert dern Array
' */
Public Sub quickSort(Optional ByVal iStart As Variant, Optional ByVal iEnd As Variant)
	If IsObject(vArray(lBoundA)) Then
		Call Err.Raise(NOT_WORK_WITH_OBJECTS, "ArrayObject.quickSort()", "The function quickSort dosnt work with Objects")
	End If
 
	Call ArrayQuickSort(vArray, iStart, iEnd)
	Call reset
End Sub
 
 
'/**
' * Sucht den Index eines Elementes
' * @param  Variant     Element
' * @return Long        Index des Elementes oder -1
' */
Public Function find(ByRef iElement As Variant) As Long
 
  If Me.isEmpty Then
	find = NOT_FOUND
	Exit Function
  End If
  If IsObject(iElement) Then
 
	'Objekte vergleichen:
	For find = LBound(vArray) To UBound(vArray)
	  If IsObject(vArray(find)) _
	  Then If iElement Is vArray(find) _
		   Then Exit Function
	Next find
 
  Else
 
	'"Normale" Werte vergleichen:
	For find = LBound(vArray) To UBound(vArray)
	  If Not IsObject(vArray(find)) _
	  Then If iElement = vArray(find) _
		   Then Exit Function
	Next find
 
  End If
 
  'Kein Treffer:
  find = NOT_FOUND
End Function
 
'/**
' * der Array selber
Public Property Get list() As Variant
	list = vArray
End Property
Public Property Let list(ByVal list As Variant)
	vArray = list
	reset
End Property
 
Public Property Get elementType() As VbVarType
	elementType = vType
End Property
Public Property Let elementType(ByVal iType As VbVarType)
	vType = iType
End Property
 
'------------------------------------------------------------------------------------------------
' private methodes
'------------------------------------------------------------------------------------------------
 
'/**
' * Setzt den Wert an einem bestimmten Index. Löst das Object-Problem
' * @param  Long        Index
' * @param  Variant     Element
' */
Private Sub setV(ByVal iIndex As Long, ByRef iValue As Variant)
	If IsObject(iValue) Then
		Set vArray(iIndex) = iValue
	Else
		vArray(iIndex) = iValue
	End If
End Sub
 
'/**
' * Gibt den Wert eines bestimmten Indexes. Löst das Object-Problem
' * @param  Long        Index
' * @param  Variant     Element
' */
Private Sub getV(ByVal iIndex As Long, ByRef iValue As Variant)
	If IsObject(vArray(iIndex)) Then
		Set iValue = vArray(iIndex)
	Else
		iValue = vArray(iIndex)
	End If
End Sub
 
'http://www.vbarchiv.net/archiv/tipp_details.php?pid=372
Private Sub ArrayQuickSort(ByRef ioArray As Variant, _
  Optional ByVal iStart As Variant, _
  Optional ByVal iEnd As Variant)
 
  ' Wird die Bereichsgrenze nicht angegeben,
  ' so wird das gesamte Array sortiert
 
  If IsMissing(iStart) Then iStart = LBound(ioArray)
  If IsMissing(iEnd) Then iEnd = UBound(ioArray)
 
  Dim i As Long
  Dim J As Long
  Dim h As Variant
  Dim x As Variant
 
  i = iStart: J = iEnd
  x = ioArray((iStart + iEnd) / 2)
 
  ' Array aufteilen
  Do
 
	While (ioArray(i) < x): i = i + 1: Wend
	While (ioArray(J) > x): J = J - 1: Wend
 
	If (i <= J) Then
	  ' Wertepaare miteinander tauschen
	  h = ioArray(i)
	  ioArray(i) = ioArray(J)
	  ioArray(J) = h
	  i = i + 1: J = J - 1
	End If
  Loop Until (i > J)
 
  ' Rekursion (Funktion ruft sich selbst auf)
  If (iStart < J) Then ArrayQuickSort ioArray, iStart, J
  If (i < iEnd) Then ArrayQuickSort ioArray, i, iEnd
End Sub