User Tools

Site Tools


vba:functions:substrreplace

[VBA] substrReplace()

Diese Funktion ist analog zum PHP-Befehl substr_replace()

Version 1.0.0 (21.08.2014)

Beispiele

'Nach dem 3ten Zeichen alles ersetzen
?substrReplace("AB CD EF", "_uvw_", 3)
AB _uvw_
 
'Nach dem 3ten Zeichen einfügen
?substrReplace("AB CD EF", "_uvw_",3, 0)
AB _uvw_CD EF
 
'ab dem 3ten Zeichen 3Zeichen ersetzen
?substrReplace("AB CD EF", "_uvw_",3 ,3)
AB _uvw_EF
 
'Ab dem 3ten Zeichen von hinten ein Zeichen ersetzen
?substrReplace("AB CD EF", "_uvw_",-3, 1)
AB CD_uvw_EF
 
'Ab dem 3ten Zeichen bis zum 2t letzten Zeichen ersetzen
?substrReplace("AB CD EF", "_uvw_", 3, -2)
AB _uvw_EF
 
'Text am Anfang anfügen
?substrReplace("AB CD EF", "_uvw_",0,0)
_uvw_AB CD EF

Und noch ein einfaches Beispiel, wie man diese Funktion für RegExp-Ersetzungen gut gebrauchen kann

Dim rx As New regExp:   rx.Pattern = "\d+": rx.Global = True
Dim txt As String:      txt = "9 Hühner und 12 Schweine"
 
Dim mc As MatchCollection:  Set mc = rx.execute(txt)
'von Hinten nach vorne iterieren, damit die Startpunkte (firstIndex) ihre Gültigkeit behalten
Dim i As Integer: For i = mc.count - 1 To 0 Step -1
    Dim m As Match: Set m = mc.item(i)
    txt = substrReplace(txt, m.value ^ 2, m.firstIndex, m.length)
Next i
Debug.Print txt
 
'Ausgabe:
'81 Hühner und 144 Schweine

Code

udf_substrreplace.bas
Attribute VB_Name = "udf_substrReplace"
'-------------------------------------------------------------------------------
'File         : udf_substrReplace.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/substrReplace
'Environment  : VBA 2010 +
'Version      : 1.0.0
'Name         : substrReplace
'Author       : Stefan Erb (ERS)
'History      : 21.08.2014 - ERS - Creation
'-------------------------------------------------------------------------------
Option Explicit
 
'Analog zu substr_replace aus PHP
'iString
'Die Eingabezeichenkette.
'
'iReplacement
'Die Ersetzungszeichenkette
'
'iStart
'Ist start positiv, beginnt die Ersetzung ab der im Offset-Parameter start definierten Stelle innerhalb von string .
'Ist start negativ, wird vom Ende der Zeichenkette string bis zum Wert von start rückwärts gezählt und dort mit dem Austausch begonnen.
'
'iLength
'Ist der Parameter angegeben und positiv, stellt dieser Parameter die Länge des auszuwechselnden Teils von string dar. Ist der Wert negativ, gibt er die Zeichenzahl an, um die ab Ende von
'string rückwärts gezählt wird. Bis zu dieser Stelle erfolgt dann der Austausch. Ist der Parameter nicht angegeben, wird standardmäßig eine Ersetzung bis zum Ende des Strings (strlen(string ))
'durchgeführt, das heißt, die Ersetzung endet mit dem Ende von string . Sollte length den Wert null haben, wird die Funktion die Zeichenkette replacement in string an der durch start
'bezeichneten Stelle einfügen.
 
'/**
' * Ersetzt Text innerhalb einer Zeichenkette
' * @param  String      Die Eingabezeichenkette
' * @param  String      Die Ersetzungszeichenkette
' * @param  Integer     Start
' * @param  Integer     Länge
' * @return String
' */
Public Function substrReplace(ByVal iString As String, ByVal iReplacement As String, ByVal iStart As Integer, Optional ByVal iLength As Variant = Null) As String
    Dim startP As Integer:  startP = IIf(Sgn(iStart) >= 0, iStart, greatest(Len(iString) + iStart, 1))
    Dim length As Integer:  length = Nz(iLength, Len(iString) - iStart)
    Dim endP   As Integer
 
    Select Case Sgn(length)
        Case 1:     endP = least(startP + length, Len(iString))
        Case 0:     endP = startP
        Case -1:    endP = greatest(Len(iString) + length, startP)
    End Select
 
    substrReplace = Left(iString, startP) & iReplacement & Mid(iString, endP + 1)
 
End Function
 
'-------------------------------------------------------------------------------
' -- Private Libraries
'-------------------------------------------------------------------------------
 
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' *
' * Gibt den Grössten aus einer unbestimmten Menge von Werten zurück
' * @param  Keine Objekte
' * @return Grösster Wert
' * @example greatest("Hallo Welt", 42, "Mister-X") -> Mister-X
'*/
Private Function greatest(ParamArray iItems() As Variant) As Variant
    greatest = iItems(UBound(iItems))
    Dim item As Variant: For Each item In iItems
        If Nz(item) > Nz(greatest) Then greatest = item
    Next item
End Function
 
'/**
' * Gibt den Kleinsten aus einer unbestimmten Menge von Werten zurück
' * @param  Keine Objekte
' * @return Grösster Wert
' * @example least("Hallo Welt", 42, "Mister-X") -> 42
'*/
Private Function least(ParamArray iItems() As Variant) As Variant
    least = iItems(LBound(iItems))
    Dim item As Variant: For Each item In iItems
        If Nz(item) < Nz(least) Then least = item
    Next item
End Function
 
vba/functions/substrreplace.txt · Last modified: 29.04.2015 11:08:08 by yaslaw