Jul 15, 2013

3897

String nach Zeichenfolge durchsuchen

Guten Morgen zusammen,
einen String auf eine bestimmte Zeichenfolge zu durchsuchen ist mit hilfe von instr relativ einfach.
Nun möchte ich aber einen Wert finden der zwischen zwei bestimmten Zeichenfolgen steht. Das Problem hierbei ist das zum einen der gesuchte Wert zwischen 1 und 1000000 liegen kann und zum anderen ist die Kombination der Zeichenfolge zwischen dem er steht mehr als einmal im String vorhanden ist.

aus
2628 </TD></TR>
soll
2628
werden

ich hoffe jemand von euch kennt da eine unkomplizierten weg mein Problem zu lösen.

Please also mark the comments that contributed to the solution of the article

Content-Key: 211484

Url: https://administrator.de/contentid/211484

Printed on: April 25, 2024 at 04:04 o'clock

27 Comments

Latest comment

Moin,

musst du in VBA "per Hand" machen, oder dir eine DLL mit RegExp Funktionalität suchen und einbinden.

Per Hand in etwa
1. Per InStr das erste Vorkommen von "" suchen,
2. Ab der Position nach "" suchen
3. Das zwischen den Positionen 1. und 2. ist der gesucht String.

oder als RegExp:
"([0-9]*)"

lg,
Slainte

RegExp kenne ich noch nicht. scheint aber das zu sein was ich suche. hab jetzt auf die schnelle kein passendes Beispiel gefunden. kannst du mir das mel etwas näher erleutern?

Schau mal hier da sind RegExp anhand von Excel erklärt.

Hallöle Gundelputz,
so z.B.

strText = "<P>2628 </P></TD></TR>"  
Set myRegExp = CreateObject("vbscript.regexp")  
myRegExp.IgnoreCase = True
myRegExp.Pattern = "<P>\s*(\d{1,7})\s*<\/p>"  
Set myMatches = myRegExp.Execute(strText)
If myMatches.Count >= 1 Then
	Set myMatch = myMatches(0)
	If myMatch.SubMatches.Count >= 1 Then
		strNumber = myMatch.SubMatches(0)
		MsgBox strNumber
	End If
End If

Dieser Code nimmt den ersten Match der zutrifft in deinem Text.
Möchtest du alle Treffer anzeigen lassen geht das so:

strText = "<P>2628 </P></TD></TR><P> 55845 </P></TD></TR>"  
Set myRegExp = CreateObject("vbscript.regexp")  
myRegExp.IgnoreCase = True
myRegExp.Global = True
myRegExp.Pattern = "<P>\s*(\d{1,7})\s*<\/p>"  
Set myMatches = myRegExp.Execute(strText)
If myMatches.Count >= 1 Then
For Each myMatch In myMatches
	If myMatch.SubMatches.Count >= 1 Then
		strNumber = myMatch.SubMatches(0)
		MsgBox strNumber
	End If
Next
End If

Im Pattern ist berücksichtigt das Leerzeichen vor und hinter der Zahl vorkommen können, weil in deinem Beispiel eins davon hinter der Zahl stand.
Grüße Uwe

Danke erstmal euch beiden
@uwe
bei deinem 2. Bespiel bekomme ich die Fehlermeldung "Benutzerdefinierter Typ nicht definiert" "Zeile 2 : New RegExp)
kann es sein das ich hier den Befehl erst bekannt machen muss?

ok du arbeitest in einer Office Anwendung dann musst du das so umschreiben:

set myRegExp = CreateObject("vbscript.regexp")

vielen dank Uwe
du bist wie immer mein Held

Eine frage hab ich da noch
bei der suche erhalte mit unter bis zu 60 Treffer. nun möchte ich die suche aber noch verfeinen in dem ich die beiden voran gegangen zeilen in die suche mit ein beziehe.

Gesamt<
dg<

hab mich jetzt ein wenig belesen und im WIKI eine folgenderklährung gefunden
\r\n ein Zeilenumbruch im Windows-Format

also habe ich den Suchstring wie folgt angepasst

">Gesamt<[\r\n]>dg<[\r\n]\s*(\d{1,7})\s*<\/p>"

leider fürt das nicht zum Erfolg. Habs dann auch mit [\r] und [\n] probiert mit gdem gleichen erfolg.
könnt ihr mir hier noch mal helfen?

Hallo Gundelputz,
dieses RegEx kann nicht funktionieren.
Und solch ein Tag : <[\r\n]> ohne Tagnamen mit Zeilenumbruch habe ich in HTML auch noch nie gesehen.
Bitte poste mal einen etwas größeren Ausschnitt um die Zahl die du erfassen möchtest, aber bitte mit Tags damit hier keine Sonderzeichen in deinem Text verloren gehen.
Dann bau ich dir ein passendes RegEx dazu ...

Grüße Uwe

Guten Morgen Uwe,
vielen Dank für dein Angebot. Mit Hilfe von excel habe ich die Website eines Druckers ausgelesen und in eine Variable gespeicht.

Set webtest = CreateObject("InternetExplorer.application")
webtest.navigate "http://10.2.38.79/cgi-bin/dynamic/printer/config/reports/devicestatistics.html"
''webtest.Visible = True
Do: Loop Until webtest.Busy = False
text = webtest.document.DocumentElement.outerHTML

anschliessend habe ich, mit deiner Hilfe, den Inhalt nach allen Zählerständen die in der Variable waren gesucht und diese in einem Tabellenblatt gespeichert

strText = text
Set myRegExp = CreateObject("vbscript.regexp")
myRegExp.IgnoreCase = True
myRegExp.Global = True
myRegExp.Pattern = "[^<\d]*(\d{1,7})[^<\d]*<\/p>"
Set myMatches = myRegExp.Execute(strText)
If myMatches.Count >= 1 Then
For Each myMatch In myMatches
If myMatch.SubMatches.Count >= 1 Then
strNumber = myMatch.SubMatches(0)
Worksheets("Tabelle1").Cells(zeile, 1) = strNumber
zeile = zeile + 1
'MsgBox strNumber
End If
Next
End If

leider stehen, auf Grund der unterschiedlichen konfiguration der Drucker, die Zählerstände nicht immer in der gleichen Zeile.
im Web habe ich dann eine beschreibung von RegEx gefunden(https://de.wikipedia.org/wiki/Regul%C3%A4rer_Ausdruck) und die o.g. ergänzungen getätigt.
Der gewünschte Zähler befindet sich in folgenden Text

Gesamt</TD>
<TD>
2628 </TD></TR>
<TR>

Die erste Zeile ist zwar immer noch 3-6 mal vorhanden kann aber dann durch weiter Suchergebnisse so weit eingegrenzt werden das am ende der gewünschte Zähler ermittelt werden kann.
Ich hoffe ich konnte dir mein Problem näher bringen.

brauchst du mehrere Zählerstände auf der Seite oder nur einen ? und ist dies der erste Eintrag mit dieser Zeile?

Für diesen Code

<P style="MARGIN-LEFT: 40px" align=left>Gesamt</P></TD>
<TD>
<P>2628 </P></TD></TR>
<TR>

ginge folgender RegEx Ausdruck:

myRegExp.Pattern = "<P style="MARGIN-LEFT: 40px" align=left>Gesamt<\/P><\/TD>\s*<TD>\s*<P>\s*(\d{1,7})\s*<\/P>"

wenn du nur den ersten Treffer von der Seite brauchst, löschst du folgende Zeile im obigen Code oder setzt sie auf FALSE:

myRegExp.Global = True

vielen Dank für die schnelle Antwort
habe mit der Zeile ers mal nen Fehler bekommen der auf den Begriff Margin hinweist. hab dann also den String soweit angepasst.
"align=left>Gesamt<\/P><\/TD>\s*<TD>\s*\s*(\d{1,7})\s*</TD></TR>"
da der Anfang immer gleich ist. So Funktioniert es dann.
noch mal vielen Dank

Guten Morgen,
leider habe ich noch ein en Fehler beim Auslesender Maschinen bekommen.
sobald ich ein Firmwareupdate mache kann es passieren das die werte nicht die sind die ich brauche.
in der Website steht es wie folgt:

Gedr. Medienseiten/Anzahl
Drucken
Schwarzweiß
15236
Farbe
17030
Gesamt
32266
Fax
Schwarzweiß
46
Gesamt
46
Kopie
Schwarzweiß
10907
Farbe
2751
Gesamt
13658
Gesamt
Schwarzweiß
26189
Farbe
19781
Gesamt
45970

der Quellcode beschreibt dies so:

<TR><td>Gedr. Medienseiten/Anzahl</td><td> </td>
</TR>
<TR><td>Drucken</td><td> </td>
</TR>
<TR><td>Schwarzweiß</td><td> 15235 </td>
</TR>
<TR><td>Farbe</td><td> 17030 </td>
</TR>
<TR><td>Gesamt</td><td> 32265 </td>
</TR>
<TR><td>Fax</td><td> </td>
</TR>
<TR><td>Schwarzweiß</td><td> 46 </td>
</TR>
<TR><td>Gesamt</td><td> 46 </td>
</TR>
<TR><td>Kopie</td><td> </td>
</TR>
<TR><td>Schwarzweiß</td><td> 10907 </td>
</TR>
<TR><td>Farbe</td><td> 2751 </td>
</TR>
<TR><td>Gesamt</td><td> 13658 </td>
</TR>
<TR><td>Gesamt</td><td> </td>
</TR>
<TR><td>Schwarzweiß</td><td> 26188 </td>
</TR>
<TR><td>Farbe</td><td> 19781 </td>
</TR>
<TR><td>Gesamt</td><td> 45969 </td>

es währe jetzt für mich hilfreich wenn ich jede Zeile so in Exel inportieren könnte wie sie in der Webseit dargestellt wird. Ist dies mit geringen Aufwand moglich?

Ach ja mein bissheriger Code sieht so aus:

Dim webtest As Object
Dim text As String
Dim zeile
Dim ip_adresse As String
Dim website_count As String

zeile = 1
ip_adresse = UserForm1.txb_counter_ip.Value
website_count = "/cgi-bin/dynamic/printer/config/reports/devicestatistics.html"

Set webtest = CreateObject("InternetExplorer.application")

webtest.navigate "http://" + ip_adresse + website_count
webtest.Visible = False
Do: Loop Until webtest.Busy = False
Do: Loop Until webtest.Busy = False

text = webtest.document.DocumentElement.outerHTML

strText = text
Set myRegExp = CreateObject("vbscript.regexp")
myRegExp.IgnoreCase = True
myRegExp.Global = True
myRegExp.Pattern = "align=left>Gesamt<\/P><\/TD>\s*<TD>\s*\s*(\d{1,7})\s*</TD></TR>"
Set myMatches = myRegExp.Execute(strText)
If myMatches.Count >= 1 Then
For Each myMatch In myMatches
If myMatch.SubMatches.Count >= 1 Then
strNumber = myMatch.SubMatches(0)
Worksheets("IPzucounter").Cells(zeile, 1) = strNumber
zeile = zeile + 1
'MsgBox strNumber
End If
Next
End If

Tach Gundelputz,
guckst du hier:

Dim curCell As Range
'Startzelle für den Ausgabebereich  
Set curCell = Worksheets(1).Range("A1")  
Set regex = CreateObject("VBScript.RegExp")  
regex.Global = True
regex.IgnoreCase = True
regex.Pattern = "((Schwarzweiß|Farbe|Gesamt)<\/p><\/td><td><p>\s*(\d+)\s*<\/p>|(Drucken|Fax|Kopie|Gesamt)<\/p><\/td><td><p>(\s*)<\/p><\/td>)"  
Set matches = regex.Execute(strText)
If matches.Count <> 0 Then
    For Each Match In matches
        If Match.Submatches(3) <> "" Then  
            curCell.Value = Match.Submatches(3)
        Else
            curCell.Value = Match.Submatches(1)
        End If
        curCell.Offset(0, 1).Value = Match.Submatches(2)
        Set curCell = curCell.Offset(1, 0)
    Next
End If

Grüße Uwe

Hi Uwe.
schön von dir zu lesen.
Hab ich geguckt.
Ist nichts passiert.
hab deinen Cod wie folgt angepasst:

Dim curCell As Range

Dim webtest As Object
Dim text As String
Dim zeile
Dim ip_adresse As String
Dim website_count As String

ip_adresse = UserForm1.txb_counter_ip.Value
website_count = "/cgi-bin/dynamic/printer/config/reports/devicestatistics.html"

Set webtest = CreateObject("InternetExplorer.application")

webtest.navigate "http://" + ip_adresse + website_count
webtest.Visible = False
Do: Loop Until webtest.Busy = False
Do: Loop Until webtest.Busy = False

text = webtest.document.DocumentElement.outerHTML
strText = text

'Startzelle für den Ausgabebereich
Set curCell = Worksheets("IPzucounter").Cells(1, 1)
Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
regex.IgnoreCase = True
regex.Pattern = "((Schwarzweiß|Farbe|Gesamt)<\/p><\/td><td>\s*(\d+)\s*<\/p>|(Drucken|Fax|Kopie|Gesamt)<\/p><\/td><td>(\s*)<\/p><\/td>)"
Set matches = regex.Execute(strText)
If matches.Count <> 0 Then
For Each Match In matches
If Match.Submatches(3) <> "" Then
curCell.Value = Match.Submatches(3)
Else
curCell.Value = Match.Submatches(1)
End If
curCell.Offset(0, 1).Value = Match.Submatches(2)
Set curCell = curCell.Offset(1, 0)
Next
End If

dann hab ich mal versucht meinen Code mit deinem zu verfolständigen:

Dim webtest As Object
Dim text As String
Dim zeile
Dim ip_adresse As String
Dim website_count As String

zeile = 1
ip_adresse = UserForm1.txb_counter_ip.Value
website_count = "/cgi-bin/dynamic/printer/config/reports/devicestatistics.html"

Set webtest = CreateObject("InternetExplorer.application")

webtest.navigate "http://" + ip_adresse + website_count
webtest.Visible = False
Do: Loop Until webtest.Busy = False
Do: Loop Until webtest.Busy = False

text = webtest.document.DocumentElement.outerHTML

strText = text
Set curCell = Worksheets("IPzucounter").Range("A1")
Set myRegExp = CreateObject("vbscript.regexp")
myRegExp.IgnoreCase = True
myRegExp.Global = True
regex.IgnoreCase = True
regex.Pattern = "((Schwarzweiß|Farbe|Gesamt)<\/p><\/td><td>\s*(\d+)\s*<\/p>|(Drucken|Fax|Kopie|Gesamt)<\/p><\/td><td>(\s*)<\/p><\/td>)"
Set matches = regex.Execute(strText)
If matches.Count <> 0 Then
For Each Match In matches
If Match.Submatches(3) <> "" Then
curCell.Value = Match.Submatches(3)
Else
curCell.Value = Match.Submatches(1)
End If
curCell.Offset(0, 1).Value = Match.Submatches(2)
Set curCell = curCell.Offset(1, 0)
Next
End If
bkamm dann Fehlermeldung "Laufzeitfehler" mit verweis auf regex.IgnoreCase = True

kannst du dir da nen Reim drauf machen

Zitat von @Gundelputz:

bkamm dann Fehlermeldung "Laufzeitfehler" mit verweis auf regex.IgnoreCase = True

kannst du dir da nen Reim drauf machen

klare Diagnose

Copy n'paste Syndrom...
aus deinem Code hier...

myRegExp.IgnoreCase = True
myRegExp.Global = True
regex.IgnoreCase = True
regex.Pattern = "((Schwarzweiß|Farbe|Gesamt)<\/p><\/td><td><p>\s*(\d+)\s*<\/p>|(Drucken|Fax|Kopie|Gesamt)<\/p><\/td><td><p>(\s*)<\/p><\/td>)"  
Set matches = regex.Execute(strText)

musst du folgendes machen:

myRegExp.IgnoreCase = True
myRegExp.Global = True
myRegExp.Pattern = "((Schwarzweiß|Farbe|Gesamt)<\/p><\/td><td><p>\s*(\d+)\s*<\/p>|(Drucken|Fax|Kopie|Gesamt)<\/p><\/td><td><p>(\s*)<\/p><\/td>)"  
Set matches = myRegExp.Execute(strText)

habe ich geändert jetzt leautet die Fehlermeldung:
myregex.IgnoreCase = True

alter .... ließt du den Code überhaupt oder hast du eine Schreibschwäche ???

myRegExp

für einen Variablennamen musst du dich schon entscheiden!

Hi,
müsste in Pattern nicht irgendwo so was wie \s*(\d{1,7}) stehen für die Zahlen und irgendwas für den Text?

sorry hab mich schon so an die autovervollständigung gewöhnt

Hab mich jetzt total verrand und alles noch mal neu gemacht. kannst du bitte noch mal drüber schauen. Da geschied nämlich auch nichts(sichtbares)

Sub neu()
Dim curCell As Range

Set webtest = CreateObject("InternetExplorer.application")

webtest.navigate "http://10.2.38.59/cgi-bin/dynamic/printer/config/reports/devicestatistics.html"
webtest.Visible = False
Do: Loop Until webtest.Busy = False
Do: Loop Until webtest.Busy = False

strText = webtest.document.DocumentElement.outerHTML

'Startzelle für den Ausgabebereich
Set curCell = Worksheets("IPzucounter").Range("A1")
Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
regex.IgnoreCase = True
regex.Pattern = "((Schwarzweiß|Farbe|Gesamt)<\/p><\/td><td>\s*(\d+)\s*<\/p>|(Drucken|Fax|Kopie|Gesamt)<\/p><\/td><td>(\s*)<\/p><\/td>)"
Set matches = regex.Execute(strText)
If matches.Count <> 0 Then
For Each Match In matches
If Match.Submatches(3) <> "" Then
curCell.Value = Match.Submatches(3)
Else
curCell.Value = Match.Submatches(1)
End If
curCell.Offset(0, 1).Value = Match.Submatches(2)
Set curCell = curCell.Offset(1, 0)
Next
End If

End Sub

PS: Ja ich habe nicht nur ne Schreibschwäche sondern auch zu wenig Finger

hab jetzt mal folgendes gemacht:

If Match.submatches(3) <> "" Then
curCell.Value = Match.submatches(3)
MsgBox Match.submatches(3)
Else
curCell.Value = Match.submatches(1)
MsgBox Match.submatches(1)
End If
curCell.Offset(0, 1).Value = Match.submatches(2)
MsgBox Match.submatches(2)
Set curCell = curCell.Offset(1, 0)

dies sollte doch bei einem Treffer zu nem Ergebnis via anzeige einer Msgbox führen. Da dem nicht so ist gehe ich davon aus das der Code zwar funktioniert nur das Suchergebnis nicht existiert.
Wenn ich den Suchstring richtig interpr. so sucht er erst nach den Text "Schwarzweiß", "Farbe" und "Gesamt" und gibet diesen in Submatches(1) zurück. Dann sucht er nach einer Poitiven Zahl und giebt diese in Submatches(2) zurück. Anschliessend noch mal nach dem Tex und dann nach NULL o. Leerzeichen.
Habe ich das so richtig verstanden?

habs jetz mal auf den alten Suchstring angepasst:

regex.Pattern = "(align=left>Gesamt<\/P><\/TD>\s*<TD>\s*\s*(\d{1,7})\s*</TD></TR>)" '"((Schwarzweiß|Farbe|Gesamt)<\/p><\/td><td>\s*(\d+)\s*<\/p>|(Drucken|Fax|Kopie|Gesamt)<\/p><\/td><td>(\s*)<\/p><\/td>)"
Set matches = regex.Execute(strText)
If matches.Count <> 0 Then
For Each Match In matches
If Match.submatches(1) <> "" Then
curCell.Value = Match.submatches(1)
MsgBox Match.submatches(1)
Else
curCell.Value = Match.submatches(1)
MsgBox Match.submatches(1)
End If
curCell.Offset(0, 1).Value = Match.submatches(0)
MsgBox Match.submatches(0)
Set curCell = curCell.Offset(1, 0)

dort bekomme ich ein Ergebnis. Zu erst den Wert(Zahl) und dann align=left>Gesamt</TD>

schuldigung dann bekomme ich
align=left>Gesamt</TD>

<TD>

12296 </TD></TR>

mit folgendem Suchstring bekomme ich schon fast das was ich möchte.
"(align=left>(Gedr. Medienseiten/Anzahl|Schwarzweiß|Farbe|Gesamt)<\/P><\/TD>\s*<TD>\s*\s*(\d{1,7})\s*</TD></TR>)"
einzieg die Gedr. Medienseiten/Anzahl bekomme ich nicht ausgegeben.
Kannst du mir da noch mal weiterhelfen?

German solved Question VB for Applications Development

Hotly discussed

Check of ZFW Firewallgleixnerd - 5 Comments

Wireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 Comments