13.12.2012, aktualisiert um 11:36:35 Uhr

7817

VBA String zwischen zwei Zeichenketten auslesen

Hallo,

ich habe folgendes Problem:

Dim strContent As String
Dim LineTag As String
Dim LineStart As Integer
Dim LineEnd As Integer
   
            strContent = "<Typ> Elektroseilwinde <Typ> Manuelle Seilwinde"   
            LineStart = 0 '  
            LineEnd = 1 

    Do
            LineStart = InStr(LineEnd, strContent, "<Typ>")  
            LineEnd = InStr(LineStart, strContent, "<Typ>")  
     
            LineTag = Mid(strContent, LineStart + 1, LineEnd - LineStart - 1)
    Loop Until LineEnd = Len(strContent)

Es soll nun immer nur ab dem 1. "<Typ>" bis zum 2. "<Typ>" ausgelesen werden.
Immer einschließlich des vorangegangen "<Typ>"

Also es soll mir dann folgendes nacheinander ausgegeben werden:
<Typ> Elektroseilwinde

im 2. Durchlauf der Schleife soll:
<Typ> Manuelle Seilwinde
ausgegeben werden.

Der Teilstring soll sozusagen beim ersten "<Typ>" beginnen und vor dem 2. "<Typ>" aufhören.

Kann mir jemand weiterhelfen?

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 195815

Url: https://administrator.de/forum/vba-string-zwischen-zwei-zeichenketten-auslesen-195815.html

Ausgedruckt am: 14.05.2025 um 11:05 Uhr

9 Kommentare

Neuester Kommentar

Hallo,

Bei mir funktioniert es so:

Dim strContent As String
Dim LineTag As String
Dim LineStart As Integer
Dim LineEnd As Integer
   
            strContent = "<Typ> Elektroseilwinde <Typ> Manuelle Seilwinde"  
            LineStart = 0 '  
            LineEnd = 1

    Do
            LineStart = LineEnd
            LineEnd = InStr(LineStart + 1, strContent, "<Typ>")  
            If LineEnd = 0 Then LineEnd = Len(strContent) + 1
     
            LineTag = Mid(strContent, LineStart, LineEnd - LineStart)
            Debug.Print LineTag 
    Loop Until LineEnd = Len(strContent) + 1

Wobei ich persönlich diese Variante schöner finde:

Dim strContent As String
Dim LineTag As String
Dim s As Variant
Const delimiter = "<Typ>"  
   
            strContent = "<Typ> Elektroseilwinde <Typ> Manuelle Seilwinde"  
            
            For Each s In Split(strContent, delimiter)
                  LineTag = delimiter & s
                  Debug.Print LineTag 
            Next s

...und was zum Testen:

strContent = Split("<Typ> Elektroseilwinde <Typ> Manuelle Seilwinde" ,"<Typ>")  
Wscript.Echo Join(strContent,vbcrlf)

Gruss
Tsuki

Ps.: oder als Oneliner

Wscript.Echo Join(Split("<Typ> Elektroseilwinde <Typ> Manuelle Seilwinde" ,"<Typ>"),vbcrlf)  

Warum dann nicht gleich?

Wscript.Echo Replace("<Typ> Elektroseilwinde <Typ> Manuelle Seilwinde" ,"<Typ>",vbcrlf)  

Allerdings fehlt dann der <Typ>, daher wenn dann so:

Wscript.Echo Replace("<Typ> Elektroseilwinde <Typ> Manuelle Seilwinde" ,"<Typ>",vbcrlf & "<Typ>")  

Nur das da dann eine Leerzeile zu viel ist und außerdem die evtl. Einzelverarbeitung auch nicht möglich ist.

Hallo miniversum,

bei den String-Verarbeitungen gibt es viele Wege nach Rom

Die Replace-Methode macht sicher letztenendlich dasselbe.

Wie man's dreht und wendet, der TO soll sich das für ihn/sie beste Szenario rauspicken. Es ist Weihnachtszeit

Hier mal noch einer, den ich meinen Jungs am Anfang immer mit auf den weg gebe (nur zum spielen!!!):

'example "how to make things complicated or easy" by using string functions  

Dim MyText
Dim MyTextNew1
Dim MyTextNew2
Dim MyTextNew3

MyText = "1,2,3,4,5,6"  

MyTextNew1 = ""  
MyTextNew2 = ""  
MyTextNew3 = ""  

'***************************Methode 1****************************************  
For i = 1 to len(MyText)
	temp = mid(MyText,i,1)	
		IF temp = "," then  
			temp = "\"  
		Else
			temp = temp
		End IF
	MyTextNew1 = MyTextNew1 & temp
next

WScript.Echo MyTextNew1 & " Methode 1"  
'****************************************************************************  


'***************************Methode 2****************************************  
temp = Split(MyText , ",")  
MyTextNew2 = Join(temp, "\")  

WScript.Echo MyTextNew2 & " Methode 2"  
'****************************************************************************  


'***************************Methode 3****************************************  
MyTextNew3 = Replace(MyText, "," , "\")  
 
WScript.Echo MyTextNew3 & " Methode 3"  
'****************************************************************************  

Gruss
Tsuki

Vielen Dank für eure zahlreiche Hilfe!
Habe mich sehr gefreut, konnte leider jetzt erst antworten.

der erste Vorschlag funktioniert soweit, nur habe den code erweitern müssen.

Dieser lautet nun:

  Set fs = CreateObject("Scripting.FileSystemObject")  
  Set a = fs.CreateTextFile("T:\Typschild\" & LfschNr & Chr(45) & LfschPos & Chr(45) & LfschUPos & ".xml", True)  
    
  intStart = 0
  intEnd = 1
  LineStart = 0 '  
  LineEnd = 1 '  
  strStart = 0 '  
  strEnd = 1 '  
    
  a.WriteLine ("<LASERPLUSJOB>")  
  a.WriteLine (Chr(9) & ("<JOBNAME>") & ("TestOrder") & ("</JOBNAME>"))  
  a.WriteLine (Chr(9) & ("<TEMPLATE>") & ("C:\TemplateFiles\" & strTemplate) & ("</TEMPLATE>"))  

  strContent = "<Typ><Test1><Test2><Test3><Test4><Test5>-------<Typ><Test6><Test7><Test8><Test9><Test10>"  

If InStr(strContent, "-------") > 0 Then '  
        
        Do
            a.WriteLine (Chr(9) & ("<TAGGROUP>")) '  
            a.WriteLine (Chr(9) & Chr(9) & ("<NROFTAGS>") & ("1") & ("</NROFTAGS>")) '  
            LineStart = LineEnd
            LineEnd = InStr(LineStart + 1, strContent, "<Typ>")  
            
            If LineEnd = 0 Then LineEnd = Len(strContent) + 1

               LineTag = Mid(strContent, LineStart, LineEnd - LineStart)
               Debug.Print LineTag
             MsgBox (LineTag)
            
            Do
                intStart = InStr(intEnd, LineTag, "<")  
                intEnd = InStr(intStart, LineTag, ">")  
     
                strTag = Mid(LineTag, intStart + 1, intEnd - intStart - 1)
  
                'MsgBox (strTag), vbMsgBoxSetForeground  
     
                a.WriteLine (Chr(9) & Chr(9) & ("<TEXT>") & strTag & ("</TEXT>"))  
     
            Loop Until intEnd = Len(LineTag)
            a.WriteLine (Chr(9) & ("</TAGGROUP>")) '  
       Loop Until LineEnd = Len(strContent) + 1

Nun kommt in der Zeile 33 folgender Fehler: Laufzeitfehler 5 - Ungülter Prozeduraufruf oder ungültiges Argument

Kann mia jemand da weiterhelfen?

Danke nochmals.

Beste Grüße

Ja!
mach mal aus deiner Zeile 04

intStart = 1

Gruss
Tsuki

Guten Morgen,

funktioniert immer noch nicht, selber Fehler an der gleichen Stelle.
Die Ausgabe der xml-Datei hat sich auch nicht verändert.

Ausgabe in XML-Datei:

<LASERPLUSJOB>
	<JOBNAME>TestOrder</JOBNAME>
	<TEMPLATE>C:\TemplateFiles\ce2.pl</TEMPLATE>
	<TAGGROUP>
		<NROFTAGS>1</NROFTAGS>
		<TEXT>Typ</TEXT>
		<TEXT>Zeile1a</TEXT>
		<TEXT>Zeiel2</TEXT>
		<TEXT>Zeile2a</TEXT>
		<TEXT>Zeile3</TEXT>
		<TEXT>Zeile3a</TEXT>
		<TEXT>Zeile4</TEXT>
		<TEXT>Zeile4a</TEXT>

Die Ausgabe sollte normalerweise so lauten, wenn Sie richtig funktionieren würde:

<LASERPLUSJOB>
	<JOBNAME>TestOrder</JOBNAME>
	<TEMPLATE>C:\TemplateFiles\ce2.pl</TEMPLATE>
	<TAGGROUP>
		<NROFTAGS>1</NROFTAGS>
		<TEXT>Typ</TEXT>
		<TEXT>Zeile1a</TEXT>
		<TEXT>Zeiel2</TEXT>
		<TEXT>Zeile2a</TEXT>
		<TEXT>Zeile3</TEXT>
		<TEXT>Zeile3a</TEXT>
		<TEXT>Zeile4</TEXT>
		<TEXT>Zeile4a</TEXT>
       </TAGGROUP>
       <TAGGROUP>
                <NROFTAGS>1</NROFTAGS>
                <TEXT>Typ</TEXT>
		<TEXT>Zeile1c</TEXT>
		<TEXT>Zeiel2b</TEXT>
		<TEXT>Zeile2c</TEXT>
		<TEXT>Zeile3b</TEXT>
		<TEXT>Zeile3c</TEXT>
		<TEXT>Zeile4b</TEXT>
		<TEXT>Zeile4c</TEXT>
       </TAGGROUP>
</LASERPLUSJOB>

und in dem Textfeld strContent (aus diesem Feld werden die Daten ausgelesen) steht dieser Text:

<Typ> <Zeile1a>
<Zeiel2> <Zeile2a>
<Zeile3> <Zeile3a>
<Zeile4> <Zeile4a>
-----------------------
<Typ><Zeile1c>
<Zeile2b><Zeile2c>
<Zeile3b><Zeile3c>
<Zeile4b><Zeile4c>

wenn ich intStart in der 4. Zeile wieder auf "0" setze, dann ist sogar die Ausgabe gleich, also verändert hat sich dadurch gar nichts.

Kann mir jemand nochmals helfen?

Trotzdem danke an TsukiSan

Beste Grüße

ich habe nun eine Funktion eingebaut, die zählen soll wie oft "<Typ>" vorkommt.
Jetzt will ich eine for schleife schreiben, diese soll abhängig vom der zähl-Funktion sein. Kommt zb <Typ> zweimal vor, so soll die for-Schleife zwei mal durchlaufen.

Die zähl-Funktion funktioniert einwandfrei. Diese heisst cntOccurence, diese gibt wiederum einen Integer-Wert zurück.
Das heißt, wenn <Typ> zweimal vorkommt, dann gibt die Funktion eine 2 zurück.

Weiss jemand wie ich das machen kann? Schleifen sind leider nicht so meine Stärke.

Danke schon mal.

Hallo
Sorry hab jetzt erst wieder reingeschaut.

Ich denke ich würde das ganze eher so machen (ohne die ersten beiden Zeilen und das schreiben in eine Datei (wäre dann die letzte Zeile bei folgendem Code)):

    strContent = "<Typ><Test1><Test2><Test3><Test4><Test5>-------<Typ><Test6><Test7><Test8><Test9><Test10>"  
    strout = ""  
    
    strout = strout & "<LASERPLUSJOB>"  
    strout = strout & vbTab & "<JOBNAME>TestOrder</JOBNAME>" & vbNewLine  
    strout = strout & vbTab & "<TEMPLATE>C:\TemplateFiles\" & strTemplate & "</TEMPLATE>" & vbNewLine  
    
    For Each s In Split(strContent, "<Typ>")  
        ps = InStr(1, s, "<")  
        pe = InStrRev(s, ">")  
        If ps > 0 And pe > 0 Then
            strout = strout & vbTab & "<TAGGROUP>" & vbNewLine  
            strout = strout & vbTab & vbTab & "<NROFTAGS>1</NROFTAGS>" & vbNewLine  
            strout = strout & vbTab & vbTab & "<TEXT>Typ</TEXT>" & vbNewLine  
            
            ts = Mid(s, ps, pe - ps + 1)
            ts = Replace(ts, ">", "#")  
            ts = Replace(ts, "<", vbTab & vbTab & "<TEXT>")  
            ts = Replace(ts, "#", "</TEXT>" & vbNewLine)  
            strout = strout & ts
            
            strout = strout & vbTab & "</TAGGROUP>" & vbNewLine  
        End If
    Next s
    
    strout = strout & "</LASERPLUSJOB>"  
    
    MsgBox strout