'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/pregreplacecallback
' * Führt eine Callback-Funktion über alle Trefferelemente aus und ersetzt diese im Text
' * @example            Ein Beispiel. ich habe eine Funktion getMin(v1,v2) welche den kleineren der Beiden Werte zurückgibt.
' *                     Nun will ich in einem Text alle 'zwieschen v1 und v2' damit berechnen lassen und ersetzen
' *                     Print preg_replace_callback("zwieschen (\d) und (\d)", "getMin", "wir haben zwieschen 1 und 4 Biere und zwieschen 5 und 3 Weine")
' *                     Eingabe: 'wir haben zwieschen 1 und 4 Biere und zwieschen 5 und 3 Weine'
' *                     Ausgabe: 'wir haben 1 Biere und 3 Weine'
' * @param  String      Pattern analog RegExp
' * @param  String      Name der Callback-Funktion
' * @param  String      Der String der bearbeitet werden soll
' * @param  Boolean     Multiline-Eigenschaft von RegExp
' * @param  Boolean     IgnoreCase-Eigenschaft von RegExp
' * @param  Boolean     Global-Eigenschaft von RegExp
' * @return String
' */
Public Function rx_replace_callback( _
        ByVal iPattern As String, _
        ByRef iCallback As Variant, _
        ByVal iSubject As String, _
        Optional ByVal iFlags As rxFlagsEnum = rxGlobal + rxIgnorCase _
) As String
    'Dim rx      As New regExp
    'Dim mc      As MatchCollection
    'Dim m       As Match
    Dim rx      As Object: Set rx = CreateObject("VBScript.RegExp")
    Dim mc      As Object
    Dim m       As Object
    Dim smc()   As String
    Dim ret     As String
    Dim i, k

    rx.Global = iFlags And rxGlobal
    rx.IgnoreCase = iFlags And rxIgnorCase
    rx.Multiline = iFlags And rxMultiline

    rx.Pattern = iPattern
    Set mc = rx.execute(iSubject)

    rx_replace_callback = iSubject
    For i = mc.count - 1 To 0 Step -1
        Set m = mc.Item(i)
        'Alle Submatches zu Argumenten zusammenführen
        ReDim smc(m.SubMatches.count - 1)
        For k = 0 To UBound(smc): smc(k) = """" & m.SubMatches(k) & """": Next k
        ret = CStr(Eval(iCallback & "(" & join(smc, ",") & ")"))
        'Unterstring ersetzen
        rx_replace_callback = Left(rx_replace_callback, m.FirstIndex) & ret & Mid(rx_replace_callback, m.FirstIndex + m.Length + 1)
    Next i

    Set m = Nothing
    Set mc = Nothing
    Set rx = Nothing

End Function