oxanag
Dec 13, 2012, updated at 10:36:35 (UTC)
view6864
view9
0
Goto Top

VBA String zwischen zwei Zeichenketten auslesen

GermanQuestionVB for ApplicationsDevelopment
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?
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 195815

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

Printed on: April 19, 2024 at 00:04 o'clock

9 Comments
Latest comment
Goto Top
Member: miniversum
miniversum Dec 13, 2012 at 11:40:23 (UTC)
Goto Top
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
Member: TsukiSan
TsukiSan Dec 13, 2012 updated at 12:11:13 (UTC)
Goto Top
...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)
Member: miniversum
miniversum Dec 13, 2012 at 12:36:36 (UTC)
Goto Top
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.
Member: TsukiSan
TsukiSan Dec 13, 2012 at 13:21:20 (UTC)
Goto Top
Hallo miniversum,

bei den String-Verarbeitungen gibt es viele Wege nach Rom face-wink
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 face-smile

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
Member: OxanaG
OxanaG Dec 13, 2012 updated at 15:57:00 (UTC)
Goto Top
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
Member: TsukiSan
TsukiSan Dec 13, 2012 at 16:00:41 (UTC)
Goto Top
Ja!
mach mal aus deiner Zeile 04
intStart = 1

Gruss
Tsuki
Member: OxanaG
OxanaG Dec 14, 2012 updated at 07:08:32 (UTC)
Goto Top
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
Member: OxanaG
OxanaG Dec 14, 2012 updated at 09:17:13 (UTC)
Goto Top
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.
Member: miniversum
miniversum Dec 14, 2012 at 12:50:53 (UTC)
Goto Top
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

Ich hoffe das hilft dir weiter
GermanQuestionVB for ApplicationsDevelopment
Hotly discussed
AlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 1 CommentDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment