HOLA!!!
Hoy queria hacer un split que devuelva un array con varios delimitadores y aparte tenga la opcion de guardar el delimitador... en fin... hice esta funcion, espero que les sirva.
Antes que el codigo Ejemplo:
Private Sub Ejemplo()
Dim dels(3) As String
Dim result() As String
Const ss As String = "hola+como--andas(((esto====es+una--prueba"
dels(0) = "+"
dels(1) = "--"
dels(2) = "((("
dels(3) = "===="
'sin preservar delimitadores
result = MultiSplit7913(ss, dels, False)
'result = ("hola";"como";"andas";"esto";"es";"una";"prueba")
'preservando delimitadores
result = MultiSplit7913(ss, dels, True)
'result = ("hola";"+como";"--andas";"(((esto";"====es";"+una";"--prueba")
End Sub
El Codigo
Private Function MultiSplit7913(expression As String, Delimiter() As String, PreserveDel As Boolean) As String()
Dim DelCount As Long
Dim lExp As Long
Dim X As Long
Dim Pos As Long
Dim DelPos() As Long
Dim AuxArr() As String
Dim LastPos As Long
Dim LastLen As Long
Dim LastInstr As Long
expression = expression & Delimiter(0)
lExp = Len(expression)
DelCount = UBound(Delimiter)
ReDim DelPos(lExp)
For X = 0 To DelCount
Pos = 1
LastInstr = InStr(Pos, expression, Delimiter(X))
Do While LastInstr <> 0
DelPos(LastInstr) = X + 1
Pos = LastInstr + Len(Delimiter(X)) + Pos
LastInstr = InStr(Pos, expression, Delimiter(X))
Loop
Next
ReDim AuxArr(0)
LastPos = 1
For X = 0 To lExp
If DelPos(X) <> 0 Then
ReDim Preserve AuxArr(UBound(AuxArr) + 1)
If PreserveDel Then
AuxArr(UBound(AuxArr) - 1) = Mid$(expression, LastPos, X - LastPos)
Else
AuxArr(UBound(AuxArr) - 1) = Mid$(expression, LastPos + LastLen, X - LastPos - LastLen)
LastLen = Len(Delimiter(DelPos(X) - 1))
End If
LastPos = X
End If
Next
ReDim Preserve AuxArr(UBound(AuxArr) - 1)
MultiSplit7913 = AuxArr
End Function
GRACIAS POR LEER!!!
Funciona, pero lo podrias mejorar ;)
Aqui te van unos ejemplos :)
- Podrias ahorrarte las 3 llamadas a InStr guardandolas en una sola variable :xD
- En lugar de guardar las posiciones con un flag, guarda en un array las posiciones de los delimitadores, asi despues evitas volver a recorrer la cadena (segundo for) y solo recorres el array y haces un mid, ya que tienes la posicion en el arreglo
Por lo demas, Esta buena la idea :)
HOLA!!!
Mmm, en cuanto al punto 1 si, lo voy a cambiar.
En cuanto al punto 2... En ese array que decis, ademas de la posicion del delimitador debo guardar el delimitador (osea delimitador(0) en posicion 3) eso me obliga a usar 2 vectores o una matriz, al usar una matriz tendria que saltar los espacios blancos que hay, pero si uso 2 vectores uno para la posicion y otro para el delimitador mmm... podria ser voy a probar.
Me dio fiaca hacer el punto 2 XD
GRACIAS POR LEER!!!
Puedes crear un tipo "marcador" con dos long, uno que indique el index del separador y otro que diga el index del char donde empieza, y asi sigues teniendo un solo arreglo :P
HOLA!!!
Si, hice eso cuando lo estapa haciendo, pero al usar instr por cada delimitador el vector estaria desordenado y ordenarlo es un bajon... la otra forma que tendria es con mid, pero seria mas lento.
GRACIAS POR LEER!!!
Pero... si ya estas insertando ordenadamente :|
HOLA!!!
No, Fijate que se hace un recorrido(hecho de instr en el while) por cada Delimitador, entonces si en el lugar 3 y 10 esta el delimitador 1 y en el lugar 7 esta el delimitador 2 el vector quedara asi:
Pos.index(3,10,7)
Pos.Delimit(1,1,2)
GRACIAS POR LEER!!!
Me entendiste mal :xD
yo me referia asi
Private Type Separador
index As Long
delimit As Long
End Type
posicion 1
.index = 3
.Delimit = 1
posicion 2
.index = 10
.delimit = 2
posicion 3
.index = 7
.delimit = 1
:P te dije, usando un solo vector :P
Esa fue una de las formas que pensé yo!! :D
DoEvents! :P
HOLA!!!
Si, en un vector, lo entiendo, pero lo que te decia era que es un bajon ordenarlo.
GRACIASPOR LEER!!!
Pero para que lo queres ordenar si ya lo estas ingresando ordenadamente
HOLA!!!
Porque ... si yo tengo esto:
Pos.index(3,10,7)
Pos.Delimit(1,1,2)
Lo que va a dar es:
Respuesta(mid(texto,1,3),mid(texto,4,10),mid(texto,11,7))
error^ ^
Entendes?
GRACIAS POR LEER!!!
Deja, sigues sin entender lo que trato de decir :xD
HOLA!!!
>:( bueno :/
GRACIAS POR LEER!!!
La mejor forma que hay se me ocurre de hacerlo, con un Type, queda superbonito ;D :
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
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! :P