6 Position eines Zeichen im Text auslese
20.04.2020 22:55:51
Siegfried
habe mich einmal etwas in Regex versucht, nach langem Suchen im WEB und lesen so das mir der Kopf raucht, konnte ich Teilerfolge erzielen.
Wie gesagt TEILERFOLGE, mir wird nur der Teil angezeigt den ich suchen habe lassen bis zum nächsten ;. Es fehlt mir aber jener Teil vom vorhergehenden ;§ bis zum Suchbegriff.
Habe hin und her probiert fand aber die Lösung leider nicht, könntest du dir einmal den Script Bitte ansehen.
In Spalte K besteht nach wie vor das Problem mit Texten die unter Namen Zahlen enthalten und daher nicht die gewünschte TelNr. bringt.
In den Spalten Q bis V hätte ich also die Restlichen Auswertungen, aber leider nur mit dem Such Teil und nicht den vollen Inhalt der Suche.
In der Spalte V mit dem Suchbegriff uschen für Duschen bringt er natürlich auch vier welche im Namen Buschenschank stehen haben, wie könnte man das unterbinden?
Hoffe werde irgendwann einmal mit Regex zurechtkommen.
Function getstring(text, Optional Titel)
Dim strpattern$
getstring = ""
Select Case LCase(Titel)
Case "name": strpattern = "\]([A-zöäüßèáâéíøåæê!\s\(\)\-\\/\d\.\+\*\~\'\#\_\,\:]+)[;\[ _
Case "plz_ort": strpattern = "\[([A-zöäüßøåæê\s\W]+\d*)\]$"
Case "strasse": strpattern = ";\s*([A-zöäüßèáâéíøåæê\s\(\)\,\.\-\-\\\/\d]+)\["
Case "tel": strpattern = "[\sA-z\.\:]*(\+*\d*[\-\/\(\s]*\d+[\-\-\/\)\s\d]*\d{2,}[\d\s\-\ _
/]*\d+[\sA-z\.\:]*[\sA-z\.\:]*\+*\d*[\-\/\(\s]*\d*[\-\/\)\s\d]*\d{2,}[\d\s\-\/]*\d*)"
Case "mail": strpattern = "\b([^\s]+@[^\s]+\.\w+)\b"
Case "preis": strpattern = "(\d+\.\d\d\s*EUR.*?);"
Case "offen": strpattern = "((offen|(ge)?öff.*|open)\:.*?)[;\[\b]"
Case "strom": strpattern = "(s*stro.*?)\;"
Case "versorgung": strpattern = "(s*versor.*?)\;"
Case "entsorgung": strpattern = "(s*entsor.*?)\;"
Case "anschluss": strpattern = "(s*anschlu.*?)\;"
Case "toilette": strpattern = "(s*ilette.*?)\;"
Case "dusche": strpattern = "(s*uschen.*?)\;"
End Select
With CreateObject("vbscript.regexp")
.ignorecase = True
.Pattern = strpattern
If .test(text) Then getstring = Trim(.Execute(text).Item(0).submatches(0))
End With
End Function
Gruß Siegfried
P.S.
Datei habe ich unter Muster_03_A.xlsm wieder hochgeladen.