Option Explicit
Private Declare Function GetTickCount Lib "Kernel32" () As Long
 
Private Sub Form_Load()
   Dim x As Long
   Dim s As String
   Dim t1 As Long
   Dim t2 As Long
 
   If App.LogMode = 0 Then
   MsgBox "Ejecutar compilado"
   End
   End If
  
   Me.AutoRedraw = True
 
   'Dessa
   Me.Print "Dessa"
   t1 = GetTickCount
   For x = 5000 To 7000
       If IsLucky(x) Then
           s = s & x & " "
       End If
   Next
   t2 = GetTickCount
   Me.Print t2 - t1 & vbNewLine
 
   MsgBox s, vbOKOnly, "Dessa"
   s = ""
 
   'Tokes
   Me.Print "Tokes"
   t1 = GetTickCount
   For x = 5000 To 7000
       If verifnum4(x) Then
           s = s & x & " "
       End If
   Next
   t2 = GetTickCount
   Me.Print t2 - t1 & vbNewLine
   MsgBox s, vbOKOnly, "Tokes"
   s = ""
End Sub
 
'Dessa

Function IsLucky(lngNum As Long) As Boolean

Dim x As Long
Dim cont As Long
Dim contStep As Long
Dim Indice As Long
Dim numLuck() As Long

If lngNum < 1 Then Exit Function
If lngNum Mod 2 = 0 Then Exit Function
If lngNum = 1 Or lngNum = 3 Then
   IsLucky = True
   Exit Function
End If
If lngNum = 5 Then Exit Function

    ReDim numLuck(lngNum)
    For x = 1 To lngNum Step 2
        numLuck(contStep) = x
        contStep = contStep + 1
    Next
    ReDim Preserve numLuck(contStep - 1)
    
contStep = 0
cont = 0
Indice = 1

While numLuck(Indice) <= UBound(numLuck)
     For x = 0 To UBound(numLuck)
       If cont = numLuck(Indice) - 1 Then
          cont = 0
       Else
           numLuck(contStep) = numLuck(x)
           cont = cont + 1
           contStep = contStep + 1
       End If
     Next
    If contStep = numLuck(Indice + 1) Then
      Exit Function
    Else
      ReDim Preserve numLuck(contStep - 1)
      If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
    End If
    cont = 0
    contStep = 0
    Indice = Indice + 1
Wend
IsLucky = True
  
End Function

 ' Tokes (Cuarto intento)
Private Function verifnum4(ByVal Num As Long) As Boolean
Dim bufA() As Long
Dim indElim As Long
Dim indElim_aux As Long
Dim ordenElim As Long
Dim i As Long
Dim i_auxA As Long
Dim i_auxB As Long


    If (Num And 1) = 0 Then
        Exit Function
    End If
    If Num < 5 Then
        verifnum4 = True
        Exit Function
    End If
    
    ReDim bufA(0 To Num)
    
    ordenElim = 2
    i = 1
    For i_auxA = 1 To Num Step 2
        bufA(i) = i_auxA
        i = i + 1
    Next i_auxA
    i = i - 1
        
    Do
        indElim = bufA(ordenElim)
        If indElim > i Then
            verifnum4 = True
            Exit Function
        End If
        If indElim = i Then Exit Function
        i_auxA = indElim
        i_auxB = indElim + 1
        Do
            For indElim_aux = indElim - 2 To 0 Step -1
                If i_auxB > i Then Exit Do
                bufA(i_auxA) = bufA(i_auxB)
                i_auxA = i_auxA + 1
                i_auxB = i_auxB + 1
            Next indElim_aux
            If i_auxB = i Then Exit Function
            i_auxB = i_auxB + 1
        Loop
        i = i_auxA - 1
        ordenElim = ordenElim + 1
    Loop
End Function