Hallo Rainer,
gute Idee, habe ich nicht gemacht, dafür braucht uns Reinhard
ja nicht. Deine Funktion aus der FAQ und gut ist’s. *fg*
Ich weiss nicht ob ich die Function StrCount mit gepostet habe, die sich dafür anbietet, wenn nicht siehst du sie gleich 
Nein. Wenn die Zeichenketten zwischendurch etwas länger sind,
eventuell ganze Texte, ist Instr() um ein vilefaches
schneller.
Ok, da hast du wiederrum Recht
Ich habe mal auf die schnelle etwas getippselt. Ich hoffe das es das ist was du suchst. kannst es mal bei dir laufen lassen und ne Zeitmessung machen, was schneller ist.
Das Bsp. ist mir nur auf die schnelle eingefallen 
und sicher noch optimierbar Naja schau es Dir mal an
Na ja, ich habe ‚gemogelt‘ Ich ersetze die Klammern erst
durch andere und beim Abarbeiten wieder durch die Richtigen,
dann ergibt sich die richtige Zuordnung von selbst. Das ist
extrem zuverlässig, aber sicher nicht der schnellste Code.
Nein, denn kannst du gewaehrleisten das das Zeichen nicht schon einmal irgendwo in dem Text da vorkommt ? Für mich waere das zu heikel und ich würde fein die {} Zeichen suchen
Ich habe kein Testfile, ich habe mir nur den Beispielstring
mit ein paar Zeichen getippt.
Teste mal bitte meine Variante und mache mal ne Zeitmessung. Mal schauen um wievieles meines langsamer ist :s
Option Explicit
Option Base 1
Private Declare Function ArrPtr Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long ' StrCount(MyData, "}") Then
MsgBox "Ungleiche Klammernpaare!", 16
Exit Sub
End If
ReDim vRet(Entry, 2)
Call GetPos(MyData, vRet())
Call GetData(MyData, vRet())
End Sub
Private Sub GetData(Text As String, vRet() As Long)
Dim i As Long
For i = 1 To UBound(vRet)
Debug.Print Mid$(Text, vRet(i, 1), vRet(i, 2) - vRet(i, 1) + 1) 'Ausgabe mit geschweiften Klammern
Next i
Erase vRet
End Sub
Private Sub GetPos(Text As String, vRet() As Long)
Dim i As Long
Dim pos As Long
Dim x As Long
Dim merker As Long
pos = 1
For i = 1 To UBound(vRet)
vRet(i, 1) = InStr(pos, Text, "{")
x = vRet(i, 1) + 1
merker = 0
Do
If Mid$(Text, x, 1) = "{" Then merker = merker + 1
If Mid$(Text, x, 1) = "}" And merker = 0 Then
vRet(i, 2) = x
Exit Do
ElseIf Mid$(Text, x, 1) = "}" And merker \> 0 Then
merker = merker - 1
End If
x = x + 1
Loop Until x \> Len(Text)
pos = vRet(i, 1) + 1
Next i
End Sub
'Liefert die Anzahl eines Zeichens in einer Zeichenkette
Public Static Function StrCount(ByRef Text As String, ByRef Find As String, Optional ByVal Start As Long = 1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Long
Const MODEMARGIN = 8
Dim TextAsc() As Integer
Dim TextData As Long
Dim TextPtr As Long
Dim FindAsc(0 To MODEMARGIN) As Integer
Dim FindLen As Long
Dim FindChar1 As Integer
Dim FindChar2 As Integer
Dim i As Long
If Compare = vbBinaryCompare Then
FindLen = Len(Find)
If FindLen Then
If Start FindAsc(i) Then Exit For
Next i
If i \> FindLen Then
StrCount = StrCount + 1
Start = Start + FindLen
End If
End If
End If
Next Start
End Select
RtlMoveMemory ByVal TextPtr, TextData, 4
RtlMoveMemory ByVal TextPtr + 4, 1&, 4
Else
FindLen = FindLen + FindLen
Start = InStrB(Start + FindLen, Text, Find)
Do While Start
StrCount = StrCount + 1
Start = InStrB(Start + FindLen, Text, Find)
Loop
End If
End If
End If
Else
StrCount = StrCount(LCase$(Text), LCase$(Find), Start)
End If
End Function
MfG Alex
