... ich hab mir mal was zusammengebastelt:
Function ReplaceSubstrings(sText As String , sSubstring As Variant , sRepString As Variant) As String
' # ReplaceSubstrings - Anton Tauscher - ata - 06.2002
' # Ersetzt in einem String bestimmte Teilstrings durch neue - 1. String alt gegen 1. String neu
' # ... sText = der eigentliche Text
' # ... sSubstring = Array mit Strings, die ersetzt werden sollen - alte Werte
' # ... sRepString = Array mit Strings, durch die ersetzt wird - neue Werte
Dim sAlt() As String
Dim sNeu() As String
Dim i As Integer
Dim lbSub As Integer
Dim ubSub As Integer
Dim lbRep As Integer
Dim ubRep As Integer
Dim sBefore As String
Dim sAfter As String
Dim sDummy() As String
Dim counter As Integer
counter = -1
If Lbound( sSubString ) <> 0 Then
For i = Lbound( sSubString ) To Ubound(sSubString)
counter = counter + 1
Redim Preserve sDummy( 0 To counter )
sDummy( counter ) = sSubString( i )
Next
sSubString = sDummy
End If
counter = -1
Redim sDummy( 0 To 0 )
If Lbound( sRepString ) <> 0 Then
For i = Lbound( sRepString ) To Ubound(sRepString)
counter = counter + 1
Redim Preserve sDummy( 0 To counter )
sDummy( counter ) = sRepString( i )
Next
sRepString = sDummy
End If
ReplaceSubstrings = ""
' # 1. Validierung der Parameter
' # ... wurde ein Text übergeben...
If sText = "" Then
' # Es wurde kein Text übergeben - Abbruch
Exit Function
End If
' # ... wurden Arrays übergeben...
If Isempty(sSubstring) Or Isempty(sRepString) Then
' # ... ... es wurden keine Arrays übergeben - Abbruch
Exit Function
Else
' # ... ... wenn ja, haben die Arrays die gleiche Anzahl Elemente...
If Ubound(sSubstring) - Lbound(sSubstring) <> Ubound(sRepString) - Lbound(sRepString) Then
' # ... ... ... die Arrays haben unterschiedlich viele Elemente -. Abbruch
Exit Function
Else
' # ... ... ... die Parameter sind überprüft - Weiter...
lbSub = Lbound(sSubstring)
ubSub = Ubound(sSubstring)
lbRep = Lbound(sRepString)
ubRep = Ubound(sRepString)
End If
End If
' # 2. Suchen der Teilstrings im Text
For i = lbSub To ubSub
Do Until Instr(sText , Cstr(sSubstring(i))) = 0
sBefore = Left(sText , Instr(sText , Cstr(sSubstring(i)))-1 )
sAfter = Right(sText , Len(stext) - Len(sBefore) - Len(Cstr(sSubstring(i))) )
sText = sBefore + sRepString(i) + sAfter
Loop
Next
ReplaceSubstrings = sText
End Function
sSubstring und sRepString sind Arrays mit Strings die ersetzt werden sollen
sSubstring(0) gegen sRepstring(0) usw...
... könnte dir weiterhelfen
ata