Hallo BH8,
um das zu erreichen brauchen wir reguläre Ausdrücke,dazu ist es nötig im Visual Basic Editor
unter Extras - Verweise das Kontrollkästchen bei Microsoft VBScript Regular Expressions 5.5 zu aktivieren.
Dann sollte folgender Code funktionieren:
Public Function TestRegExp(sTxt As String, Optional pattern As String = "(\d+)") As String
Dim regEx As RegExp
Set regEx = New RegExp
With regEx
.pattern = pattern
.IgnoreCase = True
.Global = True
End With
Set colMatches = regEx.Execute(sTxt)
For i = 0 To colMatches.Count - 1
Set reMatch = colMatches(i)
For j = 0 To reMatch.SubMatches.Count - 1
stemp = IIf(IsEmpty(stemp), reMatch.SubMatches(j), stemp & Chr(13) & reMatch.SubMatches(j))
Next j
Next i
TestRegExp = stemp
End Function
Public Function FirstLetter(ausdruck As String) As String
Dim ausnahmen, trennzeichen, worte, wort, tz
Dim newWords As String
Dim pattern As String
ausnahmen = Array("von", "und", "zu")
trennzeichen = Array("\s+", "\s*\-\s*", "$")
newWords = ""
pattern = "(.+?)(" & Join(trennzeichen, "|") & ")"
MsgBox TestRegExp(ausdruck, pattern)
worte = Split(TestRegExp(ausdruck, pattern), Chr(13))
For idx = LBound(worte) To UBound(worte) Step 2
noChange = False
For Each ausnahme In ausnahmen
If worte(idx) = ausnahme Then
noChange = True
Exit For
End If
Next
If idx > 0 Then tz = worte(idx - 1)
If noChange Then
newWords = IIf(newWords = "", worte(idx), newWords & tz & worte(idx))
Else
newWord = UCase(Left(worte(idx), 1)) & Mid(worte(idx), 2)
newWords = IIf(newWords = "", newWord, newWords & tz & newWord)
End If
Next idx
FirstLetter = newWords
End Function
Public Sub TestFirstLetter()
MsgBox (FirstLetter("dr. marc-von Moechte-nicht"))
End Sub
Grüße Lutz
|