Puedes intentar modificar un poco la funcion.
A mi a veces me pasa tambien eso y mira que j.de.
Aqui te dejo tu funcion "traducida" y con un par de lineas cambiadas de posicion.
Quiza te valga, aunque no responde igual que Split con caracteres ASCII extendido.
Private Function Separa(ByVal Cadena As String, Optional ByVal Separador As String, Optional ByVal Limite As Long = -1) As String()
Dim SiguienteCaracter As Long, PosSeparador As Long, LenCadena As Long, LenSeparador As Long, Contador As Long, MatrizAcumulador() As String
LenCadena = Len(Cadena)
If LenCadena = 0 Then GoTo QuitHere
If Separador = vbNullString Then Separador = " "
If Limite = 0 Then GoTo QuitHere
If InStr(1, Cadena, Separador, vbBinaryCompare) = 0 Then GoTo QuitHere
LenSeparador = Len(Separador)
ReDim MatrizAcumulador(0)
SiguienteCaracter = 1
PosSeparador = 1
Do
If Contador + 1 = Limite Then
MatrizAcumulador(Contador) = Mid$(Cadena, SiguienteCaracter)
Exit Do
End If
PosSeparador = InStr(PosSeparador, Cadena, Separador, vbBinaryCompare)
If PosSeparador = 0 Then
If Not SiguienteCaracter = LenCadena Then
MatrizAcumulador(Contador) = Mid$(Cadena, SiguienteCaracter)
End If
Exit Do
End If
MatrizAcumulador(Contador) = Mid$(Cadena, SiguienteCaracter, PosSeparador - SiguienteCaracter)
Contador = Contador + 1
ReDim Preserve MatrizAcumulador(Contador)
SiguienteCaracter = PosSeparador + LenSeparador
PosSeparador = SiguienteCaracter
Loop
ReDim Preserve MatrizAcumulador(Contador)
Separa = MatrizAcumulador
Exit Function
QuitHere:
ReDim Separa(-1 To -1)
End Function
Yo me he estado dejando un poco el seso y te he hecho esta otra, que aunque tarda 3 veces mas que la tuya, en miles y miles de pruebas aleatorias me ha dado el mismo resultado que Split.
Que la disfruteis:
Private Function Separa3(ByVal Cadena As String, ByVal Separador As String, Optional ByVal Limite As Long = -1) As String()
Dim Contador As Long
Dim ContadorB As Long
Dim F As Long
Dim F2 As Long
Dim Chr0 As Long
Dim Matriz() As String
Dim MatrizB() As Byte
Dim CadenaB() As Byte
Dim SeparadorB() As Byte
Dim LenSepB As Long
Dim LenCadenaB As Long
' EL ORDEN DE ESTAS COMPARACIONES ES IMPORTANTE
' PARA OBTENER EL MISMO RESULTADO QUE SPLIT
' PERO MUY, MUY IMPORTANTE :P
LenCadenaB = LenB(Cadena)
If Separador = "" Then GoTo Error2 ' si no hay separador se devuelve hasta un chr(0)
If Limite = 0 Then GoTo Error1 ' si limite es 0 se devuelve vacia
If LenCadenaB = 0 Then GoTo Error1 ' si no hay cadena se devuelve vacia
If Limite = 1 Then GoTo Error3 ' si limite es 1 se devuelve todo en una matriz con 1 elemento
If InStr(1, Cadena, Separador, vbBinaryCompare) = 0 Then GoTo Error3
'si no se encuentra el separador se devuelve una matriz de 1 solo elemento con todo
CadenaB = Cadena
SeparadorB = Separador
LenSepB = LenB(Separador)
Contador = -1 ' este controla los elementos de Matriz
ContadorB = 1 ' este controla los elementos de MatrizB
For F = 0 To LenCadenaB - 1 Step 2 ' vamos eligiendo cada caracter
If F + LenSepB <= LenCadenaB Then ' si cabe un separador miramos si lo hay
For F2 = 0 To LenSepB - 1 Step 2
If CadenaB(F + F2) <> SeparadorB(F2) Then
Exit For ' no lo hay
ElseIf CadenaB(F + F2 + 1) <> SeparadorB(F2 + 1) Then
Exit For ' no lo hay
End If
Next F2
Else
' si no cabe el separador, no hay separador. marcamos F2
F2 = 0
End If
If F2 < LenSepB - 1 Then
' si no habia separador guardamos el byte
ReDim Preserve MatrizB(ContadorB)
MatrizB(ContadorB - 1) = CadenaB(F)
MatrizB(ContadorB) = CadenaB(F + 1)
ContadorB = ContadorB + 2
Else
' si habia separador
If Contador + 1 <> Limite Then
' si no hemos llegado al limite
F = F + LenSepB - 2 ' apuntamos mas alla del separador
Contador = Contador + 1 ' creamos un nuevo elemento y guardamos lo extraido
ReDim Preserve Matriz(Contador)
If ContadorB > 1 Then Matriz(Contador) = MatrizB
ContadorB = 1 ' inicializamos la matrizb
ReDim MatrizB(1)
Else
' si hemos llegado al limite salimos
Exit For
End If
End If
Next F
If (Contador + 1 = Limite) Then
' si estamos en el limite
If F = LenCadenaB Then
' si hemos procesado toda la cadena, es que no habia
' separador y tenemos todo en matrizb, asi que lo
' guardamos en este ultimo elemento
If ContadorB > 1 Then ' aun asi, el separador puede ser el ultimo caracter
Matriz(Contador) = Matriz(Contador) & Separador & CStr(MatrizB)
Else
Matriz(Contador) = Matriz(Contador) & Separador
End If
Else
' si aun quedan caracteres es que habia separador
' hay que sacar los que quedan e incluir el separador
For F2 = F To LenCadenaB - 1 Step 2
ReDim Preserve MatrizB(ContadorB)
MatrizB(ContadorB - 1) = CadenaB(F2)
MatrizB(ContadorB) = CadenaB(F2 + 1)
ContadorB = ContadorB + 2
Next F2
Matriz(Contador) = Matriz(Contador) & Separador & CStr(MatrizB)
End If
Else
' si quedan casillas creamos una nueva
Contador = Contador + 1
ReDim Preserve Matriz(Contador)
' si hay algo en matrizb lo guardamos
If ContadorB > 2 Then Matriz(Contador) = MatrizB
End If
Separa3 = Matriz ' y devolvemos la matriz
GoTo FinFunction
Error1:
ReDim Separa3(-1 To -1) ' aqui devolvemos la matriz vacia
GoTo FinFunction
Error2:
' si no hay separador, Split usa chr(0) como fin de cadena.
' si no lo encuentra devuelve toda la cadena.
Chr0 = InStr(1, Cadena, Chr(0))
If Chr0 <> 0 Then
Cadena = Left$(Cadena, Chr0 - 1)
End If
Error3:
' aqui la devolvemos en un solo elemento
ReDim Matriz(0)
Matriz(0) = Cadena
Separa3 = Matriz
FinFunction:
End Function
Saludos
EDITO:
Parece que me falto probar sin separador y si no lo hay no da el mismo resultado que Split.
Depurando.....
EDITO2:
Arreglado, (o eso creo). Espero que vaya bien, porque no pienso volver a revisarla.
La he probado con valores aleatorios y nulos para cadena, separador y limite.
Os dejo los comentarios que he ido escribiendo para que los mas nuevos se enteren de algo.
EDITO3:
Dios mio, porque lo he vuelto a revisar.
Por no hacer un Randomize, parece ser que las pruebas no eran del todo aleatorias.
Resulta que hay al menos 1 excepcion (que investigare), y es que si el caracter separador es el Chr(7) si que falla. Devuelve diferente resultado que la funcion Split.
Vere si lo arreglo. Si no, a mi ya me parece bastante bueno
Y SIGO EDITANDO:
El problema es el limite. Parece que si hay limite falla. No se que m,, de pruebas aleatorias he hecho
El caracter 7 me salia como separador siempre con limite 2, asi que siempre fallaba. Por lo visto como tenia un margen muy grande para limite, con los demas caracteres no llegaba al limite.
Seguire depurando a ver. Es mas complicado de lo que parece
OTRA VEZ AQUI:
Listo, ya funciona (otra vez). Solo habia un par de calculos que habia deducido mal. Volveré cuando vea que lo he estado probando todo el rato con la misma cadena o vete a saber
Y OTRA VEZ:
Ya lo adverti. Ahora habia olvidado probar con cadenas vacias (creo) y con separadores que no existieran en la cadena. Ademas la funcion Split es muy suya y cuesta descubrir como va a decidir devolverte el resultado con parametros no validos.
En fin, las pruebas "aleatorias" dicen que ya funciona bien, y yo ya estoy cansado de hacer pruebas
Si encontrais errores comentadmelo.
Saludos
Mostrar Mensajes
