VBA code "umschreiben" ?

Hallo
ich habe einen VBA Code im Internet gefunden,
https://de.extendoffice.com/documents/excel/4554-excel-extract-capital-letters.html#a1
um aus eine Zelle alle Wörter die groß geschrieben sind "auszulesen"
Ich bekomme es jedoch leider nicht hin, diesen Code in den VBA-Editor so abzuändern,
dass er funktioniert
Kann jemand helfen ? Würde mich sehr freuen
Hier der Code von der inet-Seite
Funktion StrExtract (Str As String) As String 'Updateby Extendoffice
Application.Volatile Dim xStrList als Variante Dim xRet als String Dim I so lange Wenn Len (Str) = 0, dann Exit-Funktion xStrList = Split (Str, "") Wenn UBound (xStrList)> = 0 Dann für I = 0 bis UBound ( xStrList) Wenn xStrList (I) = StrConv (xStrList (I), vbProperCase), dann xRet = xRet & xStrList (I) & "" End If Next StrExtract = Left (xRet, Len (xRet) - 1) End If End Function
Danke vorab
Werner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function StrExtract(Str As String) As String Application.Volatile Dim xStrList As Variant Dim xRet As String Dim I As Long If Len(Str) = 0 Then Exit Function Else xStrList = Split(Str, " ") If UBound(xStrList) >= 0 Then For I = 0 To UBound(xStrList) If xStrList(I) = StrConv(xStrList(I), vbProperCase) Then xRet = xRet & xStrList(I) & " " End If Next StrExtract = Left(xRet, Len(xRet) - 1) End If End If End Function

Function StrExtract(ByVal Str As String) As String Dim Ll, Ret As String Ll = Split(Str) For i = 0 To UBound(Ll) If Ll(i) = StrConv(Ll(i), vbProperCase) Then Ret = Ret & Ll(i) & " " Next i StrExtract = Trim(Ret) End Function

Function StrExtract(Str As String) As String Dim Erg As String Dim Wort As String For Each Wort In Split(Str) 'Split arbeitet per Default mit Leerzeichen Select Case Left(Wort, 1) Case "A" To "Z": Erg = Erg & " " & Wort End Select Next StrExtract = Trim(Erg) End Function

Function ExtractCap(Txt As String) As String Dim objRegExp As Object Dim objMatch As Object Dim E Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Pattern = "[A-Z]\S+" objRegExp.Global = True Set objMatch = objRegExp.Execute(Txt) For Each E In objMatch ExtractCap = Trim(ExtractCap) & " " & E Next Set objRegExp = Nothing End Function

Function ExtractCap(Txt As String) As String With CreateObject("VBScript.RegExp") .Pattern = "(\b[^A-Z]*)" .Global = True ExtractCap = Application.Trim(.Replace(Txt, " ")) End With End Function Sub Test_snb() Debug.Print ExtractCap("Die erste fünf Worte sind es nicht, sagte SNB") End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA code "umschreiben" ?

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread