User Tools

Site Tools


vba:functions:array_walk

[VBA] array_walk()

Eine Callback-Funktion auf jedes Element eines Arrays anwenden

Siehe auch die durch [VBA] sprintf(), vsprintf() erweiterte Funktion 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] print_r()

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
<String()> (
    [0] => <String> 'ab'
    [1] => <String> ' cd'
    [2] => <String> ' de'
)
<Variant()> (
    [0] => <String> 'ab'
    [1] => <String> 'cd'
    [2] => <String> '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
<Date()> (
    [1] => <Date> 14.07.2013
    [2] => <Date> 03.07.2013
)
<Variant()> (
    [1] => <String> '07.14.2013'
    [2] => <String> '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
<Variant()> (
    [0] => <Long> 31
    [1] => <Long> 34
    [2] => <Long> 64
)

Code

array_walk.bas
'/**
' * 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
vba/functions/array_walk.txt · Last modified: 15.07.2014 09:49:53 by yaslaw