[SOURCE] MultiSplit7913 Un split diferente XD

[raul338]

Pero para que lo queres ordenar si ya lo estas ingresando ordenadamente

[79137913]

HOLA!!!

Porque ... si yo tengo esto:

Código [Seleccionar] Expandir

Pos.index(3,10,7)
Pos.Delimit(1,1,2)


Lo que va a dar es:

Código [Seleccionar] Expandir

Respuesta(mid(texto,1,3),mid(texto,4,10),mid(texto,11,7))
                                              error^  ^

Entendes?

GRACIAS POR LEER!!!

[raul338]

Deja, sigues sin entender lo que trato de decir

[79137913]

HOLA!!!

bueno :/

GRACIAS POR LEER!!!

[Psyke1]

La mejor forma que hay se me ocurre de hacerlo, con un Type, queda superbonito :

Código (vb) [Seleccionar] Expandir

Option Explicit

'// @ntdll.dll
Private Declare Sub RtlMoveMemory Lib "ntdll.dll" (ByVal Destiny As Long, ByVal Source As Long, ByVal Bytes As Long)

Private Type SPLIT_POSITION
   Mark        As Long
   LenBDel     As Long
End Type

Public Static Function MrFrogMultiSplit(ByRef strText$, ByRef strDelimiter$(), ByRef strOutputArray$()) As Boolean
Dim strTmpDel$, lngLenBDel&, lngLenBText&, lngUBDel&, lngLBDel&
Dim SP() As SPLIT_POSITION, tmpSP As SPLIT_POSITION
Dim lngCount&, lngStart&, B2c&, Q&, C&

   lngLenBText = VBA.Strings.LenB(strText)
   If (Not Not strDelimiter) And (lngLenBText > 0) Then
       lngLBDel = LBound(strDelimiter)
       lngUBDel = UBound(strDelimiter)

       ReDim SP(255) As SPLIT_POSITION
       lngCount = 0
       
       For Q = lngLBDel To lngUBDel
           strTmpDel = strDelimiter(Q)
           lngStart = VBA.Strings.InStrB(1, strText, strTmpDel)
           
           If (lngStart - 1)>0 Then
               lngLenBDel = VBA.LenB(strTmpDel)
               
               Do
                   tmpSP.Mark = lngStart
                   tmpSP.LenBDel = lngLenBDel
                   
                   lngStart = VBA.Strings.InStrB(lngStart + lngLenBDel, strText, strTmpDel)
                   
                   C = lngCount
                   If C Then
                       Do While tmpSP.Mark < SP(C - 1).Mark
                           C = C - 1
                           If C = 0 Then Exit Do
                       Loop
                       
                       If C < lngCount Then
                           B2c = lngCount - C
                           RtlMoveMemory VarPtr(SP(C + 1)), VarPtr(SP(C)), B2c + B2c + B2c + B2c + B2c + B2c + B2c + B2c
                       End If
                   End If
                   SP(C) = tmpSP
                   
                   lngCount = lngCount + 1
                   If lngCount And &HFF Then
                       ReDim Preserve SP(lngCount + &HFF) As SPLIT_POSITION
                   End If
               Loop While lngStart
           End If
       Next Q

       ReDim strOutputArray$(lngCount)
       lngCount = lngCount - 1
       lngStart = 1

       For Q = 0 To lngCount
           strOutputArray$(Q) = VBA.Strings.MidB$(strText, lngStart, SP(Q).Mark - lngStart)
           lngStart = SP(Q).Mark + SP(Q).LenBDel
       Next Q
       
       If (lngStart And Not 1) < lngLenBText Then
           strOutputArray$(Q) = VBA.Strings.MidB$(strText, lngStart, lngLenBText - lngStart + 2)
       End If
       
       MrFrogMultiSplit = True
   End If
End Function

Código [Seleccionar] Expandir

Private Sub Form_Load()
Const strTest$ = "My+name--is(((MrFrog====and+I--love(((frogs... :P+hahaha===="
Dim strArr$(), strDels$()
Dim FixIdeBug&()
Dim vItem

   Debug.Assert Not FixIdeBug Or App.hInstance

   strDels = Split("+ -- ((( ====", " ")

   If MrFrogMultiSplit(strTest, strDels, strArr) Then
       Debug.Print "---> "; Time$; " <---"
   
       For Each vItem In strArr
           Debug.Print vItem
       Next vItem
   End If
End Sub

DoEvents!