Разбиение строки

       Dim Lex(1 to 100) As long
       V=Split(...)
       p%=0
       for i%=0 to Ubound(V,1)
           if Cstr(V(i%)) <> "" then
              p%=p%+1
              Lex(p%)=Clng(V(i%))
           End if
      Next i%

'::: Delims - строка, состоящая из символов-разделителей
'::: Функция возвращает массив строк-лексем (разделители в число лексем не входят
'::: два и более разделителей, стоящих подряд, рассматриваются как один)
 
Function superSplit(Stri As Variant, Delims As String) As Variant
   If Len(Delims) = 0 Then
      superSplit = Stri
   Else
      d$ = Left$(Delims, 1)
      V = Split(Stri(0), d$)
      For i% = 1 To UBound(Stri, 1)
          V = mergeArr(V, Split(Stri(i%), d$))
      Next i%
      superSplit = superSplit(V, Mid$(Delims, 2))
   End If
End Function
 
':::: Слияние массивов 
 
Function mergeArr(V1 As Variant, V2 As Variant) As Variant
Dim Res() As String
   u1% = UBound(V1, 1)
   u2% = UBound(V2, 1)
   ReDim Res(0 To u1% + u2 + 2) As String
   p% = 0
   For i% = 0 To u1%
       Tmp$ = CStr(V1(i%))
       If Len(Tmp$) > 0 Then
          Res(p%) = Tmp$
          p% = p% + 1
       End If
   Next i%
   For i% = 0 To u2%
       Tmp$ = CStr(V2(i%))
       If Len(Tmp$) > 0 Then
          Res(p%) = Tmp$
          p% = p% + 1
       End If
   Next i%
   ReDim Preserve Res(0 To p% - 1) As String
   mergeArr = Res
End Function

Sub Test()
    Z = Array("abc,de;f;ijk 6 7 8")
    VV = superSplit(Z, ",; ")
    For i% = LBound(VV, 1) To UBound(VV, 1)
        Debug.Print "i="; i%; " "; VV(i%)
    Next i%
End Sub

Dim n%, V, m$, BibFun(2) As String, Lex(3) As String, Stri$, Del$
 
Private Sub Command1_Click()
If V <> 1 Then Print "Ñàìîäåëüíûé": V = 1:
Stri = "123,456,,789,,,": Del = ","
tim1 = Timer
 
For cikl = 1 To 100000
 
      Tmp$ = ""
      n = 0
      For i% = 1 To Len(Stri)
          s$ = Mid$(Stri, i%, 1)
          If s$ = Del Then
             If Tmp$ <> "" Then
                n = n + 1
                Lex(n) = Tmp$
                Tmp$ = ""
             End If
          Else
             Tmp$ = Tmp$ & s$
          End If
       Next i%
       If Tmp$ <> "" Then
          n = n + 1
          Lex(n) = Tmp$
       End If
Next cikl
 
tim2 = Timer:
Print Str(Round(tim2 - tim1, 4))
End Sub
 
Private Sub Command2_Click()
If V <> 2 Then Print "Áèáëèîòå÷íûé": V = 2:
m = "123,456,,789,,,": tim1 = Timer
 
For cikl = 1 To 100000
  m = Replace(m, ",", " ")
  m = Replace(m, "  ", " ")
  BibFun = Split(Trim(m), " ")
Next cikl
 
tim2 = Timer: Print Str(Round(tim2 - tim1, 4))
End Sub

Sub Test()
Dim objFS As Object, objFile As Object, strTemp As String, arrTemp() As String
Dim startTime As Single, endTime As Single, result As Single
 
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.OpenTextFile("e:\temp\1.txt", 1)
strTemp = objFile.ReadAll
objFile.Close
startTime = Timer
arrTemp = Split(strTemp, ",")
endTime = Timer
result = endTime - startTime
startTime = Timer
Parse strTemp, ",", arrTemp, 0
endTime = Timer
MsgBox "Размер текста (Б): " & LenB(strTemp) & vbNewLine & _
        "Результат Split(): " & result & vbNewLine & _
        "Результат Parse(): " & endTime - startTime
End Sub
 
Sub Parse(Stri As String, Del As String, Lex() As String, n As Long)
Dim i As Long
      Tmp$ = ""
      n = 0
      For i = 1 To Len(Stri)
          S$ = Mid$(Stri, i, 1)
          If S$ = Del Then
             If Tmp$ <> "" Then
                n = n + 1
                'Lex(n) = Tmp$
                Tmp$ = ""
             End If
          Else
             Tmp$ = Tmp$ & S$
          End If
       Next i
       If Tmp$ <> "" Then
          n = n + 1
          'Lex(n) = Tmp$
       End If
End Sub