This is an old revision of the document!
Diese Funktionen schreiben die Werte einer Auflistung in Variablen. Fast so wie list() in PHP.
list() ist geeignet um ein Array, Collection etc. in Variablen zu zerteilen.
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
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
'------------------------------------------------------------------------------- 'File : ListFunc ' Copyright mpl by ERB software ' All rights reserved ' http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/list 'Environment : VBA 2010 + 'Version : 1.0 'Name : list 'Author : Stefan Erb (ERS) 'History : 27.02.2014 - ERS - Creation '------------------------------------------------------------------------------- Option Explicit Public Const LIST_ERR_NO_PARAMS = vbObjectError + 5000 '/** ' * Dito zu List. Aber die Argumente ist ein vordimensionierter Array ' * @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, _ ByRef 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 isObject(iList(lBnd + i)) Then Set oParams(i) = iList(lBnd + i) Else 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 isObject(iList(keys(i))) Then Set oParams(i) = iList(keys(i)) Else 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 isObject(iList(i + 1)) Then Set oParams(i) = iList(i + 1) Else 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 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 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 oParams(i) = iList(i) Next i End If Exit_Handler: Exit Function Err_Handler: list = False GoSub Exit_Handler End Function