====== [VBA] array_walk() ====== Eine Callback-Funktion auf jedes Element eines Arrays anwenden >Siehe auch die durch [[vba:functions:printf:index]] erweiterte Funktion [[.:printf:addons#array_walkf|array_walkf()]] ===== Definition ===== Public Function array_walk( _ ByVal iFuncName As String, _ ByRef iArray As Variant, _ ParamArray iParams() As Variant _ ) As Variant ==== Voraussetzungen ==== Die Funktion array_walk() werden keine speziellen Funktionen/Referenzen verwendet. ==== Einschränkungen ==== array_walk() geht leider nur mit einem Array über native Datentypen, Da für den eval() der Wert der Variable extrahiert werden muss. ==== Parameter-Liste ==== ***iFuncName** Name der Funktion, die auf jedes Element angewendet werden soll. User Defined Functions müssen als Public deklariert sein ***iArray** Array mit den zu bearbeitenden Werten ***Weitere Params** Die folgenden Werte werden so fix an die Funktion mitgegeben ==== Rückgabewerte ==== Es wird ein Array zurückgegeben mit den veränderten Werten ===== Anwendungsbeispiel ===== > Für die Ausgabe der Resultate verwendete ich die Funktion [[vba:functions:print_r:index]] ==== Alle Werte eines Arrays trimmen ==== Public Sub testArrayWalkTrim() Dim values As Variant 'Array abfüllen. Es hat führende Leerzeichen values = split("ab, cd, de", ",") print_r values 'Alle Werte des Arrays trimmen values = array_walk("trim", values) print_r values End Sub ( [0] => 'ab' [1] => ' cd' [2] => ' de' ) ( [0] => 'ab' [1] => 'cd' [2] => 'de' ) ==== Alle Werte eines Datum-Arrays zu Strings formatieren ==== Public Sub testArrayWalkToStr() Dim dates(1 To 2) As Date Dim dateString() As Variant dates(1) = "14.7.2013" dates(2) = "3.7.2013" print_r dates 'Jedes Element in ein String Formatieren: Monat.Tag.Jahr dateString = array_walk("format", dates, "mm.dd.yyyy") print_r dateString End Sub ( [1] => 14.07.2013 [2] => 03.07.2013 ) ( [1] => '07.14.2013' [2] => '07.03.2013' ) ==== Mit eigener Funktion ==== Die Funktion muss Public sein. Ansonsten kann der eval() in array_walk() die Funktion nicht finden Public Function myFunc(ByVal iValue As Long, ByVal iFactor As Long, ByVal iSubtrahend As Long) As Long myFunc = iValue * iFactor - iSubtrahend End Function Das Testscript, dass die Funktion myFunc() für jedes Array-Element ausführt Public Sub testArrayWalk() Dim data(2) As Long, fac As Long, subt As Long data(0) = 11 data(1) = 12 data(2) = 22 fac = 3 subt = 2 print_r array_walk("myFunc", data, fac, subt) End Sub ( [0] => 31 [1] => 34 [2] => 64 ) ===== Code ===== '/** ' * Copyright mpl by ERB software ' * http://wiki.yaslaw.info ' * ' * Wendet eine Callback-Funktion auf jedes Element eines Arrays an ' * Angelehnt an die PHP-Funktion array_walk und array_map. ' * Jedoch wird hier der Array selber nicht überschrieben ' * @param String Name der Funktion, die auf jedes Element angewendet werden soll ' * @param Array<> Array mit den zu bearbeitenden Werten ' * @param ParamArray Die folgenden Werte werden so fix an die Funktion mitgegeben ' * @return Array<> Resultat ' */ Public Function array_walk( _ ByVal iFuncName As String, _ ByRef iArray As Variant, _ ParamArray iParams() As Variant _ ) As Variant Dim i, j Dim value Dim params() As Variant Dim retArray() As Variant ReDim retArray(LBound(iArray) To UBound(iArray)) 'Die zusätzlichen Paramter für den eval() vorbereiten. 'Am Anfang wird noch ein leerer Eintrag hinzugefügt. Dort kommt dann der Wert ais dem Array hinein ReDim Preserve params(UBound(iParams) + 1) For i = LBound(iParams) To UBound(iParams) params(i + 1) = IIf(IsNumeric(iParams(i)), iParams(i), """" & iParams(i) & """") Next i 'Funktion mittels eval() auf jedes Element anwenden For i = LBound(iArray) To UBound(iArray) params(0) = IIf(IsNumeric(iArray(i)), iArray(i), """" & iArray(i) & """") retArray(i) = Eval(iFuncName & "(" & join(params, ", ") & ")") Next i array_walk = retArray End Function {{tag>VBA:functions VBA Array}}