[RETO] CompWordsAlphabetically

[Psyke1]

¿Qué pasa? ¿Donde están los retos que caracterizan a  esta sección?
A ver que os parece este:

Parte 1:

Crear una función que compare dos palabras (sin importar mayúsculas) y devuelva:

Código [Seleccionar] Expandir


0 : Error
1 : La 1ª palabra va antes en el abecedario
2 : La 2ª palabra va antes en el abecedario
3 : Ambas palabras son iguales

Ejemplos:

Código [Seleccionar] Expandir


"rana"        - "" -> 0
"hola"        - "holas" -> 1
"bienvenido"  - "bienvenida" -> 2
"Ejemplo"     - "eJempLIficar"  -> 2
"igual"       - "igual"         -> 3
"PALABRA"     - "palabra"       -> 3


Espero haber sido claro... Si hay alguna duda preguntad.
Por supuesto vale todo y el más rápido gana

PD: La Parte 2 la propondré cuando esté la parte 1 finalizada...

DoEvents!

[79137913]

HOLA!!!

Listo!!!

Código (vb) [Seleccionar] Expandir

Private Function FirstWord7913(W1 As String, W2 As String) As Long

    If LenB(W1) = 0 Then
            FirstWord7913 = 0
            Exit Function
    End If

    If LenB(W2) = 0 Then
            FirstWord7913 = 0
            Exit Function
    End If

Dim ST1 As Byte
Dim ST2 As Byte
    ST1 = LCase$(W1)
    ST2 = LCase$(W2)
    If LenB(ST1) = LenB(ST2) Then
        If InStrB(1, ST1, ST2, vbBinaryCompare) Then
            FirstWord7913 = 3
            Exit Function
        End If
    End If
   
Dim B1() As Byte
Dim B2() As Byte
B1 = ST1
B2 = ST2
Dim X As Long
    If UBound(B1) > UBound(B2) Then
        For X = 1 To UBound(B2) Step 2
            If B1(X) < B2(X) Then
                FirstWord7913 = 1
                Exit Function
            ElseIf B1(X) > B2(X) Then
                FirstWord7913 = 2
                Exit Function
            End If
        Next
        FirstWord7913 = 2
        Exit Function
    Else
        For X = 1 To UBound(B1) Step 2
            If B1(X) < B2(X) Then
                FirstWord7913 = 1
                Exit Function
            ElseIf B1(X) > B2(X) Then
                FirstWord7913 = 2
                Exit Function
            End If
        Next
        FirstWord7913 = 1
        Exit Function
    End If

End Function

GRACIAS POR LEER!!!

[Karcrack]

@79137913: No creo que esa versión sea demasiado rápida

Código [Seleccionar] Expandir

LenB(W1) / 2 = 0
Por que divides entre 2?

Código (vb) [Seleccionar] Expandir

Option Explicit

Sub Main()
   Debug.Print kCompare("rana", "")
   Debug.Print kCompare("hola", "holas")
   Debug.Print kCompare("bienvenido", "bienvenida")
   Debug.Print kCompare("Ejemplo", "eJempLIficar")
   Debug.Print kCompare("igual", "igual")
   Debug.Print kCompare("PALABRA", "palabra")
End Sub

Public Static Function kCompare(ByRef s1 As String, ByRef s2 As String) As Long
    Dim b()     As Long
    If (LenB(s1) <> 0) And (LenB(s2) <> 0) Then
        If (Not Not b) = False Then
            ReDim b(-1 To 1)
            b(-1) = 1
            b(1) = 2
            b(0) = 3
        End If
        kCompare = b(StrComp(s1, s2, vbTextCompare))
    End If
End Function

Si no hubieses elegido esos numeros todo seria mas fácil

[79137913]

HOLA!!!

XD se me paso Karcrack, lo vi despues

De a poco la voy a ir optimizando

Funcion actualizada:
Cambiado Asc por AscW
Funcion convertida a Long
Agregada comparacion por InstrB

GRACIAS POR LEER!!!

[Edu]

Cuando aprendere a programar como ustedes no se rien q todavia q lo hago jaja:

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Sub Form_Load()

    Debug.Print CheckWord("elfo", "elefante")
    Debug.Print CheckWord("ave", "zorro")
    Debug.Print CheckWord("hola", "")
    Debug.Print CheckWord("zero", "zerocool")
    Debug.Print CheckWord("feo", "    ")
    Debug.Print CheckWord("frog", "frog")
    Debug.Print CheckWord("faso", "fasa")
    Debug.Print CheckWord("JOJO", "jojo")
   
   
End Sub

Function CheckWord(sFirst As String, sSecond As String) As Long
    Dim i       As Integer
    Dim max     As Integer

    sFirst = LCase$(Trim$(sFirst))
    sSecond = LCase$(Trim$(sSecond))

' Verificar error
    If sFirst = "" Or sSecond = "" Then
        CheckWord = 0: Exit Function
    End If

' Establecer valor maximo del bucle
    If Len(sFirst) < Len(sSecond) Then
        max = Len(sFirst)
    Else
        max = Len(sSecond)
    End If

'Bucle
For i = 1 To max

    If (Left(sFirst, i) < Left(sSecond, i)) Then
        CheckWord = 1
        Exit Function

    ElseIf (Left(sFirst, i) > Left(sSecond, i)) Then
        CheckWord = 2
        Exit Function

' Si por ahora es igual..
    ElseIf (Left(sFirst, i) = Left(sSecond, i)) Then

        If i = max Then ' Si ya termina el bucle comprobamos..

            If Len(sFirst) > Len(sSecond) Then
                CheckWord = 2
                Exit Function
            End If

            If Len(sFirst) < Len(sSecond) Then
                CheckWord = 1
                Exit Function
            End If

' Por descarte..

            CheckWord = 3
            Exit Function

        End If
    End If

Next i

End Function



Salida:

Código [Seleccionar] Expandir


2
1
0
1
1
3
2
3


Edit: Ahora veo q me falto lo de comparar con las mayusculas fuck, conrazon se mataban ustedes jaja, no creo q me den las bolas para hacer

[79137913]

HOLA!!!

Jajaja, no me habia percatado del strcomp XD ya fue voy a seguir viendo, GRANDE Karcrack

GRACIAS POR LEER!!!

[Edu]

Ma q asco q das Karcrack xD !!

[Karcrack]

PROBLEM?

PD: Quien haga las pruebas de velocidad que sea bondadoso y desactive la comprobacion de tamaño del buffer y esas cositas para que todo sea mas rapido y divertido

[Psyke1]

 
Mi forma era igual que la tuya!
Te odio, pero me buscaré la vida para hacerlo diferente, quizás no más rapido pero si diferente.
Asi que no testeeis aun...
Por la tarde posteo la parte 2 del reto

Gracias por participar...

DoEvents!

[79137913]

HOLA!!!

Con razon el "Por supuesto vale todo" 

GRACIAS POR LEER!!!