Diese Funktion schreibt die Werte einer Auflistung in Variablen. Fast so wie list() in PHP. list() ist geeignet um ein Array, Collection etc. in Variablen zu zerteilen.

Download udf_list.bas (V-1.1.1)

Dieselbe Technik verende ich auch bei der Klasse [VBA] Iterator.
Iterator→list() und Iterator→listNext()

Public Function list( _
        ByRef iList, _
        ParamArray oParams() As Variant _
) As Boolean

• iList Die Liste. Dies kann ein Array, Dictionary, Collection, Regexp.MatchCollection, Regexp.Match oder DAO.Recordset sein
• oParams Die Variablen, die überschrieben werden

list() gibt ein Boolean zurück.Je nachdem, ob die iList abgearbeitet werde kann oder nicht

Für die Ausgabe der Resultate verwendete ich die Funktion [VBA] print_r().

Der Array kann mit Index 0 beginnen oder auch einen anderen LBound haben. Indiesem Beispiel get der Index von 1 bis 4

Public Sub testList()
    Dim myArray(1 To 4) As Variant
    Dim retA    As Integer, retB    As String, retC    As Variant
 
    'Array abfüllen. Es ist egal, ob der Array einen lbound() von 0 oder etwas anderem hat
    myArray(1) = 1
    myArray(2) = "B"
    myArray(3) = Null
    myArray(4) = "iv"
 
    'Weniger Variablen übergeben als Werte im Array sind
    list myArray, retA, retB, retC
 
    'Variabeln begutachten
    print_rm retA, retB, retC
End Sub

<Integer> 1
<String> B
<Null> 

Collection und Dictionary funktionieren gleich. Bei beiden werden die Keys verworfen

Public Sub testList()
    Dim myCol As New Collection
    Dim retA As Integer, retB As String, retC As Variant
 
    'Array abfüllen
    myCol.add 1
    myCol.add "B"
    myCol.add Null
    myCol.add "iv"
 
    list myCol, retA, retB, retC
 
    'Variabeln begutachten
    print_rm retA, retB, retC
End Sub

<Integer> 1
<String> B
<Null> 

In diesem Beispiel verwende ich die meine eigenen RegExp Funktionen, Geht aber mit der Standartanwednung von RegExp

Public Sub testList()
    Dim mc As MatchCollection
    Dim von As Variant, nach As Variant, x As Variant, y As Variant
    Dim i As Long
 
    Set mc = rx_match("([A-H])([1-8])", "Springer von A1 auf B3")
 
    Debug.Print "//Auswertung MatchCollection:"
    list mc, von, nach
 
    print_rm von, nach
    Debug.Print "//Auswertung Matches:"
    For i = 0 To mc.count - 1
        Debug.Print "//Index " & i
        list mc(i), x, y
        print_rm x, y
    Next i
 
End Sub

//Auswertung MatchCollection:
<String> A1
<String> B3
//Auswertung Matches:
//Index 0
<String> A
<String> 1
//Index 1
<String> B
<String> 3

In diesem Beispiel arbeite ich mit dem Rückgabewert um ein Recordset abzuarbeiten

Public Sub testList()
    Dim rs As DAO.Recordset
    Dim id As Integer, nr1 As Long, nr2 As Long
 
    Set rs = CurrentDb.OpenRecordset("SELECT id, number_one, number_two FROM [_test]")
 
    Do While list(rs, id, nr1, nr2)
        Debug.Print id & ": " & nr1 & " + " & nr2 & " = " & nr1 + nr2
        rs.MoveNext  'Nicht vergessen. list() macht keinen Vorschub!
    Loop
End Sub

1: 3 + 5 = 8
2: 4 + 8 = 12
3: 5 + 2 = 7
4: 7 + 5 = 12

udf_list.bas

Attribute VB_Name = "udf_list"
'-------------------------------------------------------------------------------
'File         : udf_list.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/list
'Environment  : VBA 2010 +
'Version      : 1.1.1
'Name         : list
'Author       : Stefan Erb (ERS)
'History      : 27.02.2014 - ERS - Creation
'               09.10.2014 - ERS prüfung auf isMissing() hinzugefügt, ref()hinzugefügt
'               09.10.2015 - ERS Methode ref() auf Private umgestellt
'-------------------------------------------------------------------------------
Option Explicit
 
Public Const LIST_ERR_NO_PARAMS = vbObjectError + 5000
 
'/**
' * Diese Funktion schreibt die Werte einer Auflistung in Variablen. Fast so wie list() in PHP. list() ist geeignet um ein Array, Collection etc. in Variablen zu zerteilen.
' * @param  Liste           Array, Dictionary, Collection, Regexp.MatchCollection, Regexp.Match oder DAO.Recordset
' * @param  Array<Varaint>  Auflistung der Variablen, die abgefüllt werden
' * @return Boolean         Angabe, ob die ganze Sache gültig war
' */
Public Function list( _
        ByRef iList As Variant, _
        ParamArray oParams() As Variant _
) As Boolean
    Dim lBnd    As Long:    lBnd = 0
    Dim uBnd    As Long:    uBnd = UBound(oParams)
    Dim i       As Long
On Error GoTo Err_Handler
 
    If uBnd = -1 Then Err.Raise LIST_ERR_NO_PARAMS, "list", "No Parameters"
 
    'Array
    If IsArray(iList) Then
        If lBnd < LBound(iList) Then lBnd = LBound(iList)
        If uBnd + lBnd > UBound(iList) Then uBnd = UBound(iList) - lBnd
        list = True 'Bei einem nicht initialisertem Array generierendie vorherenden Zeilen bereits ein Fehler -> Code abgebrochen, Return: False
        For i = 0 To uBnd
            If Not IsMissing(oParams(i)) Then ref oParams(i), iList(lBnd + i)
        Next
    'Dictionary
    ElseIf TypeName(iList) = "Dictionary" Then
        list = iList.Count > 0:     If Not list Then Exit Function
        Dim keys  As Variant:   keys = iList.keys
        If uBnd > iList.Count - 1 Then uBnd = iList.Count - 1
        For i = 0 To uBnd
            If Not IsMissing(oParams(i)) Then ref oParams(i), iList(keys(i))
        Next i
    'Collection
    ElseIf TypeName(iList) = "Collection" Then
        list = iList.Count > 0:     If Not list Then Exit Function
        If uBnd > iList.Count - 1 Then uBnd = iList.Count - 1
        For i = 0 To uBnd
            If Not IsMissing(oParams(i)) Then ref oParams(i), iList(i + 1)
        Next i
    'MatchCollection
    ElseIf TypeName(iList) = "IMatchCollection2" Then
        list = iList.Count > 0:     If Not list Then Exit Function
        If uBnd > iList.Count - 1 Then uBnd = iList.Count - 1
        For i = 0 To uBnd
            If Not IsMissing(oParams(i)) Then oParams(i) = iList(i).value
        Next i
    'Match
    ElseIf TypeName(iList) = "IMatch2" Then
        list = iList.subMatches.Count > 0:     If Not list Then Exit Function
        If uBnd > iList.subMatches.Count - 1 Then uBnd = iList.subMatches.Count - 1
        For i = 0 To uBnd
            If Not IsMissing(oParams(i)) Then oParams(i) = iList.subMatches(i)
        Next i
    'Recorset
    ElseIf TypeName(iList) = "Recordset2" Then
        list = Not iList.BOF And Not iList.EOF: If Not list Then Exit Function
        If uBnd > iList.fields.Count - 1 Then uBnd = iList.fields.Count - 1
        For i = 0 To uBnd
            If Not IsMissing(oParams(i)) Then oParams(i) = iList(i)
        Next i
    Else
        Err.Raise 13  'Type mismatch
    End If
 
Exit_Handler:
    Exit Function
Err_Handler:
    list = False
    GoSub Exit_Handler
End Function
 
 
'/**
' * Bei einer Variablenübergabe muss immer unterscheiden werden, ob es ein Objekt ist oder nicht.
' * Diese Sub nimmt einem die Arbeit ab
' * ref(oNode, iNode)
' * @param  Variant     Variable, die den Wert bekommen soll
' * @param  Variant     Ret Wert selber
' */
Private Sub ref(ByRef oNode As Variant, ByRef iNode As Variant)
    If IsObject(iNode) Then: Set oNode = iNode: Else: oNode = iNode
End Sub