SplitBegToEnd

[Space]

Пишу свою ф-ю разрезки строки (должна вырезать куски от метки sBeg до метки sEnd, метки входят в кусок) и писать в массив строк так, чтобы при соедиении элементов массива получилась исходная строка. Всегда должен возвращаться сформированный массив (массив существует). Почти написал, тест показал проблему - надо искать sBeg(начало вырезки) и sEnd(конец вырезки) одновременно, затем резать. Может, есть решение попроще, а то замучился уже.

Код: Выделить всё

Private Sub Form_Load()
Dim s() As String
s = SplitBegToEnd("", "1", "2")
PrintRes s
s = SplitBegToEnd("1", "1", "2")
PrintRes s
s = SplitBegToEnd("12", "1", "2")
PrintRes s
s = SplitBegToEnd("132", "1", "2")
PrintRes s
s = SplitBegToEnd("a", "1", "2")
PrintRes s
s = SplitBegToEnd("1234", "1", "2")
PrintRes s
s = SplitBegToEnd("1342", "1", "2")
PrintRes s
s = SplitBegToEnd("3142", "1", "2")
PrintRes s
s = SplitBegToEnd("12ab1212", "1", "2")
PrintRes s
s = SplitBegToEnd("22a1212a11", "1", "2") 'здесь неверно режет, должно 22a;12;;12;a11;
PrintRes s
s = SplitBegToEnd("11a1212a22", "1", "2")
PrintRes s

End Sub

'режет строку на части по меткам sBeg и sEnd (метки входят в некоторые части)
Public Function SplitBegToEnd(Source As String, sBeg As String, sEnd As String) As String()
Dim sArrTemp() As String, i As Long, Pos As Long, Pos2 As Long

0:  Pos = InStr(Pos2 + 1, Source, sBeg)
    If Pos = 0 Then Pos = 1
    'If Pos > 1 Then: Pos2 = Pos - 1: Pos = 1: GoTo 2
1:
    ReDim Preserve sArrTemp(i)
    sArrTemp(i) = Mid(Source, Pos2 + 1, Pos - Pos2 - 1)
    i = i + 1
3:
    Pos2 = InStr(Pos + 1, Source, sEnd)
    If Pos2 = 0 Then Pos2 = Len(Source)
2:
    ReDim Preserve sArrTemp(i)
    sArrTemp(i) = Mid(Source, Pos, Pos2 - Pos + 1)
    i = i + 1
    If Pos2 < Len(Source) Then
    Pos = InStr(Pos2 + 1, Source, sBeg)
    If Pos = 0 Then
     ReDim Preserve sArrTemp(i)
     sArrTemp(i) = Mid(Source, Pos2 + 1)
    Else
     GoTo 1
    End If
    End If
'здесь я доделаю сам удаление пустых элементов sArrTemp
'...
    ReDim SplitBegToEnd(UBound(sArrTemp))
    SplitBegToEnd = sArrTemp
End Function

Public Sub PrintRes(Source() As String)
Dim i As Long

For i = 0 To UBound(Source)
Debug.Print Source(i) & ";";
Next
Debug.Print
End Sub

[alibek]

Непонятно, что же все-таки требуется.

[pronto]

Автор, попробуй этот вариант

Код: Выделить всё

Private ub As Long

Option Explicit

Private Sub Form_Load()
   Dim s() As String

   s = SplitBegToEnd("11221211212", "1", "2")
   Debug.Print "11221211212"
   PrintRes s

   s = SplitBegToEnd("1", "1", "2")
   Debug.Print "1"
   PrintRes s

   s = SplitBegToEnd("12", "1", "2")
   Debug.Print "12"
   PrintRes s

   s = SplitBegToEnd("132", "1", "2")
   Debug.Print "132"
   PrintRes s

   s = SplitBegToEnd("a", "1", "2")
   Debug.Print "a"
   PrintRes s

   s = SplitBegToEnd("1234", "1", "2")
   Debug.Print "1234"
   PrintRes s

   s = SplitBegToEnd("1342", "1", "2")
   Debug.Print "1342"
   PrintRes s

   s = SplitBegToEnd("3142", "1", "2")
   Debug.Print "3142"
   PrintRes s

   s = SplitBegToEnd("12ab1212", "1", "2")
   Debug.Print "12ab1212"
   PrintRes s

   s = SplitBegToEnd("22a1212a11", "1", "2") '
   Debug.Print "22a1212a11"
   PrintRes s

   s = SplitBegToEnd("11a1212a22", "1", "2")
   Debug.Print "11a1212a22"
   PrintRes s

End Sub


Public Function SplitBegToEnd(Source As String, sBeg As String, sEnd As String) As String()
   Dim tArr() As String, LeftPart As String

   Dim i As Long, k As Long
   
   Dim lPos As Long, rPos As Long
   
   Dim ascB As Long, ascE As Long

   Dim SourceLen As Long

   ascB = Asc(sBeg)
   ascE = Asc(sEnd)

   ub = 0
   ReDim tArr(ub)
   
   SourceLen = Len(Source$)
   
   Do While SourceLen > i
     
      i = i + 1
     
      If Asc(Mid$(Source$, i, 1)) = ascB Then
         lPos = i
         
         k = i
         Do While SourceLen > k
         
            k = k + 1
           
            If Asc(Mid$(Source$, k, 1)) = ascE Then
               rPos = k + 1
               
               LeftPart = Mid$(Source, 1, lPos - 1)
               If Len(LeftPart$) > 0 Then
                  tArr(ub) = LeftPart$
                  ub = ub + 1
                  ReDim Preserve tArr(ub)
               End If
               
               tArr(ub) = Mid$(Source$, lPos, rPos - lPos)
               Source$ = Mid$(Source$, rPos)
               SourceLen = Len(Source$)
               ub = ub + 1
               ReDim Preserve tArr(ub)
               
               i = 0
               Exit Do
               
            End If
           
         Loop

      End If
     
   Loop
   
   tArr(ub) = Source$
   If SourceLen = 0 Then ub = ub - 1
   
   SplitBegToEnd = tArr
   
End Function

Public Sub PrintRes(Source() As String)
   Dim i As Long
   
   For i = 0 To ub 'ound(Source) '- 1
      Debug.Print Source(i) & ";";
   Next
   
   Debug.Print vbCrLf
End Sub