Autor
|
Tema: [RETO] Alternativa a Instr() (Leído 18,696 veces)
|
Tokes
Desconectado
Mensajes: 140
|
Saludos: Aquí les dejo una mejora (creo) del código de raul338. La he llamado Ratok338InStr: Private Function RaTok338InStr(ByVal Start As Long, ByVal s1 As String, ByVal s2 As String) As Long Dim pos1 As Long, long1 As Long, long2 As Long, lim As Long, c As String
If Start And &H80000000 Then Start = -Start long1 = Len(s1) long2 = Len(s2) If long1 = 0 Or long2 = 0 Or Start > long1 Or Start = 0 Or long2 > long1 Then RaTok338InStr = -1 Exit Function End If lim = long1 - long2 + 1 c = Mid(s2, 1, 1) For pos1 = Start To lim If Mid(s1, pos1, 1) = c Then If Mid(s1, pos1, long2) = s2 Then RaTok338InStr = pos1 Exit Function End If End If Next End Function Hasta la próxima.
|
|
|
En línea
|
|
|
|
Sanlegas
Desconectado
Mensajes: 131
https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-
|
aca el mio Public Function InstrNew(ByVal Start As Integer, ByVal Str1 As String, ByVal Str2 As String) As Integer If Start = 0 Or Str1 = "" Or Str2 = "" Then InstrNew = -1 Exit Function End If Do While Start <= Len(Str1) If Mid(Str1, Start, Len(Str2)) = Str2 Then InstrNew = Start Exit Function End If Start = Start + 1 Loop End Function una pregunta... como lo pongo con colores ?
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
. mmmm No se que tan rapida sea mi funcion pero cumple su cometido xP Public Function RetInstr(ByVal Start As String, ByVal String1 As String, ByVal String2 As String, Optional ByVal Compare As VbCompareMethod = VbCompareMethod.vbBinaryCompare) As Long Dim Var_Arr As Variant Dim lng_ST1 As Long Dim lng_UST As Long lng_ST1 = Len(String1) If Not Start > lng_ST1 Then Var_Arr = Split(Right$(String1, lng_ST1 - Start), String2, 2, Compare) lng_UST = UBound(Var_Arr) If lng_UST > 0 Then RetInstr = Start + Len(Var_Arr(0)) + 1 End If End If End Function
Dulces Lunas!¡. .
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
. Bueno aquí mas corto... ojala nos dejara VB6 usar apuntadores tan facil como en C... asi seria otra historia. Como no quiero gastar mucho el Do Loop o el For Nest por que se gastan ( jaja ) use las Split(). Public Function RetInstr(ByVal Start As String, ByVal String1 As String, ByVal String2 As String, Optional ByVal Compare As VbCompareMethod = VbCompareMethod.vbBinaryCompare) As Long Dim lng_ST1 As Long lng_ST1 = Len(String1) If Not Start > lng_ST1 Then RetInstr = Start + Len(Split(Right$(String1, lng_ST1 - Start), String2, 2, Compare)(0)) + 1 If RetInstr > lng_ST1 Then RetInstr = 0 End If End Function
Dulces Lunas!¡. .
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
TGa.
Desconectado
Mensajes: 43
|
Listo ya modifique mi funcion tenia un pequeño error, creo que ya no da resultados erroneos.
|
|
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Ya corregi el código (creo), ahora no tengo mucho tiempo. Pensé que iría más rápido si trabajaba con Bytes... Ya haré más versiones. DoEvents!
|
|
« Última modificación: 1 Enero 2011, 11:52 am por Mr. Frog © »
|
En línea
|
|
|
|
krabby
Desconectado
Mensajes: 22
|
hola super bien el reto que has propuesto Mr Frog., aki mi code, esta comentado, lo probe y no tiene fallas. si le encuentran una falla me dicen y me lanzo del 5to piso. usa la misma sintaxis que el instr() Option Explicit
Public Function Rapidash(Posicion As Long, CadenaDondeBuscar As String, MiCadenaBuscar As String) As Long Dim Cadena As String, CadenaBuscar As String Cadena = CadenaDondeBuscar CadenaBuscar = MiCadenaBuscar 'si cadena es menor q cadenabuscar, entonces cadenabuscar no esta 'contenida dentro de cadena If Len(Cadena) < Len(CadenaBuscar) Then Exit Function 'si posicion es mayor a texto, entonces no hay donde buscar 'porque posicion excede el tamaño de la cadena If Posicion > Len(Cadena) Then Exit Function 'posicion debe ser igual o mayor a1 If Posicion < 1 Then Exit Function 'si no hay cadenabuscar salimos If Len(CadenaBuscar) = 0 Then Exit Function 'la cadena serà partida en 2 desde posicion 'en caso de que posicion sea mayor a 1 'es para simplificar el trabajo de busqueda 'extra almacena el tamaño de la primera 'parte del string partido Dim Extra As Long If Posicion > 1 Then 'coge la porcion de cadena indicada por Posicion 'para simplificar la busqueda Cadena = Mid(Cadena, Posicion) Extra = Posicion - 1 End If
Dim arrCad() As String, TamCadenaBuscar As Long, Resul As Long TamCadenaBuscar = Len(CadenaBuscar) 'comprueba si la cadena se encuentra al inicio y le suma 'lo Extra en caso de que se haya partido la cadena en 2 y sale If Left(Cadena, TamCadenaBuscar) = CadenaBuscar Then Resul = 1 + Extra Else 'comprueba si la CadenaBuscar existe dentro 'de cadena Dim tmp As String tmp = Replace(Cadena, CadenaBuscar, "") 'si no varia el tamaño kiere decir ' q "NO" se encontro CadenaBuscar y sale 'esto es para no caer en el split 'y se produzca un error al sumar 'el len(arrCad(0)), ya q si split falla 'no habrà el inidce cero "0" If Len(tmp) = Len(Cadena) Then Exit Function End If 'si llega aki entonces se encontro la CadenaBuscar arrCad = Split(Cadena, CadenaBuscar) 'suma el extra y el tamaño 'arrCad(0) simpre va contener el string 'anterior a cadenabuscar, por eso la suma de abajo Resul = Len(arrCad(0)) + 1 + Extra End If Rapidash = Resul End Function
Private Sub Form_Load() Dim Pos As Long Dim UnaCadena As String Dim CadenaBuscar As String UnaCadena = "hola que tal viejo, me llamo pepe" CadenaBuscar = "viejo" Pos = Rapidash(1, UnaCadena, CadenaBuscar) MsgBox "Resultado Rapidash: " & Pos Pos = InStr(1, UnaCadena, CadenaBuscar) MsgBox "Resultado InStr: " & Pos End Sub salu2
|
|
« Última modificación: 1 Enero 2011, 14:44 pm por krabby »
|
En línea
|
|
|
|
krabby
Desconectado
Mensajes: 22
|
el proyecto que subieron para probar las funciones tiene errores, lo descargue, y algunos resultados no son correctos. debajo de main donde dice 'raul388 , pasas los parametros incorrectos: '' ================ COMPROBACION =========================== Debug.Print "============ COMPROBACION ============" cFirst = InStr(firstPos, SearchString, SearchChar) cSecond = InStr(secondPos, SearchString, SearchChar) cThird = InStr(thirdPos, SearchString, SearchChar) Debug.Print "Valores de InStr: ", , cFirst, cSecond, cThird ' Raul338 tFirst = rInStr(firstPos, SearchChar, SearchString) tSecond = rInStr(secondPos, SearchChar, SearchString) tThird = rInStr(thirdPos, SearchChar, SearchString) If tFirst <> cFirst Or tSecond <> cSecond Or tThird <> cThird Then Debug.Print "Raul338 no devuelve los mismos valores", tFirst, tSecond, tThird End If ' Miseryk tFirst = myInstr(firstPos, SearchString, SearchChar) tSecond = myInstr(secondPos, SearchString, SearchChar) tThird = myInstr(thirdPos, SearchString, SearchChar) If tFirst <> cFirst Or tSecond <> cSecond Or tThird <> cThird Then Debug.Print "Miseryk no devuelve los mismos valores", tFirst, tSecond, tThird End If el orden de parametros de instr y myInstr(de Miseryc) son iguales (firstPos, SearchString, SearchChar), pero en el de raul338 esta al reves (firstPos, SearchChar, SearchString).
|
|
|
En línea
|
|
|
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
jeje si, año nuevo, cabeza nueva, pense que toda la vida lo usaba asi y lo puse asi ya cambio la firma Hay actualizo mi funcion Benchmark actualizados 1 ============ RETO INSTR 31/12/10 ============ String a buscar: col String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena. Nº de vueltas: 250 3 Offsets: 1 10 20
============ COMPROBACION ============ Valores de InStr: 67 67 67
============ VELOCIDAD ============ InStr 0,864775284178946 Raul338 18,3623837347693 Miseryk 30,7958742805302 gaston93 3,87963529112102 Mr Frog 7,84405750497397 Tokes 30,0233925932865 79137913 20,6618641060995 Tokes v2 17,7496594728775 Tenient101 19,7694039508204 BlackZeroX 5,31231935060211 krabby 7,9775094908101
2 ============ RETO INSTR 31/12/10 ============ String a buscar: la String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena. Nº de vueltas: 250
3 Offsets: 1 10 20 ============ COMPROBACION ============ Valores de InStr: 4 10 34 BlackZeroX no devuelve los mismos valores 4 16 34
============ VELOCIDAD ============ InStr 0,599789684803091 Raul338 3,56973796574262 Miseryk 4,66494248411889 gaston93 6,10917527314349 Mr Frog 4,43525108542018 Tokes 4,75540753220973 79137913 3,40099819519021 Tokes v2 3,20082021643602 Tenient101 2,88387175007523 BlackZeroX 4,6777744058339 krabby 7,79785617083907
3 ============ RETO INSTR 31/12/10 ============ String a buscar: Ñ String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena. Nº de vueltas: 250
3 Offsets: 1 10 20 ============ COMPROBACION ============ Valores de InStr: 0 0 0
============ VELOCIDAD ============ InStr 0,706294635037691 Raul338 26,3284343194879 Miseryk 95,6028468901517 gaston93 3,07185940320015 Mr Frog 0,653042159920391 Tokes 48,7631246499291 79137913 31,470826946779 Tokes v2 27,1888146704795 Tenient101 35,9883049865489 BlackZeroX 3,53637496928359 krabby 3,62555682520292
y el proyecto con las funciones actualizadas http://www.mediafire.com/?bbr7r0s90xmgtp6PD: EL codigo exclusivamente de vb se pone asi [code=vb]Dim s as string[/code] Quedando Dim s as string
|
|
« Última modificación: 1 Enero 2011, 18:11 pm por raul338 »
|
En línea
|
|
|
|
krabby
Desconectado
Mensajes: 22
|
supongo que dices por lo del color, no sabia lo de poner el code =vb, igual no es muy conveniente cuando kieres copiar / pegar un codigo que tiene esas etiquetas, porque en vez de salir los saltos de linea salen unos espacios y hay que editar el codigo poniendo lo saltos correspondientes. voi a bajar y provar como va ahora tu tester de funciones corregido. un saludo
|
|
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
[AYUDA] Usar INSTR 2 veces
Programación Visual Basic
|
Rudy21
|
5
|
2,893
|
9 Julio 2008, 04:01 am
por cassiani
|
|
|
como cargar 100 KBs en una variable; problema con InStr
Programación Visual Basic
|
drakolive
|
5
|
3,043
|
31 Diciembre 2008, 15:20 pm
por Dessa
|
|
|
Instr para byte arrays [src]
Programación Visual Basic
|
cobein
|
3
|
2,310
|
31 Mayo 2009, 12:42 pm
por cobein
|
|
|
Alternativa a pow? [c]
« 1 2 »
Programación C/C++
|
flacc
|
10
|
11,747
|
11 Diciembre 2010, 15:25 pm
por pucheto
|
|
|
[ANSI C] Split(), strlen(), mid(), Instr(), strcpy().
« 1 2 »
Programación C/C++
|
BlackZeroX
|
11
|
10,254
|
14 Enero 2011, 02:35 am
por Littlehorse
|
|