Autor
|
Tema: [RETO] Comprobar si un numero dado es un numero de la suerte (Leído 22,025 veces)
|
Dessa
Desconectado
Mensajes: 624
|
Pude mejorar en parte a mi primera version, bueno, algo es algo... Tambien me queda pendiente la sugerencia de Psyke. Option Explicit Private Declare Function GetTickCount Lib "Kernel32" () As Long
Private Sub Form_Load() If App.LogMode = 0 Then MsgBox "Ejecutar Compilado" End ' perdon por el end End If Dim t1 As Long Dim t2 As Long Me.AutoRedraw = True t1 = GetTickCount Me.Print IsLucky(45235) & " IsLucky" t2 = GetTickCount Me.Print t2 - t1 End Sub Function IsLucky(lngNum As Long) As Boolean Dim x As Long, cont As Long, contStep As Long, Indice As Long, 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 If lngNum = 5 Then Exit Function For x = 1 To lngNum Step 2 ReDim Preserve numLuck(contStep) numLuck(contStep) = x contStep = contStep + 1 Next contStep = 0: cont = 0: Indice = 1 While numLuck(Indice) <= UBound(numLuck) If numLuck(UBound(numLuck)) <> lngNum Then Exit Function x = -1 While x < UBound(numLuck) x = x + 1 If cont = numLuck(Indice) - 1 Then cont = 0 Else numLuck(contStep) = numLuck(x) cont = cont + 1 contStep = contStep + 1 End If Wend If contStep = numLuck(Indice + 1) Then ReDim Preserve numLuck(contStep - 2) Else ReDim Preserve numLuck(contStep - 1) End If cont = 0 contStep = 0 Indice = Indice + 1 Wend For x = 0 To UBound(numLuck) If numLuck(x) = lngNum Then IsLucky = True Exit For End If Next End Function
|
|
« Última modificación: 15 Agosto 2010, 08:53 am por Dessa »
|
En línea
|
Adrian Desanti
|
|
|
Tokes
Desconectado
Mensajes: 140
|
Señores, he corregido mi código. Finalmente pude hacer la función un tanto más compacta y más rápida que la primera y la segunda versión que hice. Les dejo el código (la función se llama verifnum3 porque es el tercer intento que hice): Private Function verifnum3(ByVal num As Long) As Boolean Dim bufA() As Long Dim indElim As Long Dim indElim_aux As Long Dim ordenElim As Long Dim iniciales 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 ReDim bufA(0 To num) ReDim bufB(0 To num) ordenElim = 2 iniciales = 1 i = 1 Do While iniciales <= num bufA(i) = iniciales iniciales = iniciales + 2 i = i + 1 Loop i = i - 1 If ordenElim >= i Then verifnum3 = True Exit Function End If Do indElim = bufA(ordenElim) ordenElim = ordenElim + 1 If indElim > i Then verifnum3 = True Exit Function End If If bufA(indElim) = num Then Exit Function i_auxA = indElim i_auxB = indElim + 1 Do For indElim_aux = 2 To indElim 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 Loop End Function
|
|
|
En línea
|
|
|
|
Angeldj27
Desconectado
Mensajes: 199
Ahorra Agua... Beba Cerveza
|
@Angeldj27No funciona bien me da varios errores en las matrices, y solo haces tres bucles para quitar numeros el resultado no sera correcto, leete bien el link que puso karcrack al principio... DoEvents¡! Talvez hay que definirle un numero fijo a la dimencion del array o matrix pero es raro me funciona bien y con lo k dices, voy eliminando numeros como dice el link de karcrack y chekeo la matriz y si el numero no esta hay se supone k no es numero de la suerte es simple logica ami me funciona de 10
|
|
|
En línea
|
"Que vamos a hacer Mañana?..... Lo mismo que hacemos todos los dias Pinky tratar de Conquistar el Mundoooo!!!!!
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Mira, te pongo un ejemplo: Dim x As Long Dim s As String For x = 5000 To 5500 'If Check_Lucky_Number3(x) Then If LuckyNumber(x) Then s = s & x & " " End If Next Debug.Print s
Me devuelve: 5001 5005 5007 5011 5013 5019 5023 5025 5029 5031 5035 5041 5043 5047 5049 5053 5055 5061 5065 5067 5071 5073 5077 5083 5085 5089 5091 5095 5097 5103 5107 5109 5113 5115 5119 5125 5127 5131 5133 5137 5139 5145 5149 5151 5155 5157 5161 5167 5169 5173 5175 5179 5181 5187 5191 5193 5197 5199 5203 5209 5211 5215 5217 5221 5223 5229 5233 5235 5239 5241 5245 5251 5253 5257 5259 5263 5265 5271 5275 5277 5281 5283 5287 5293 5295 5299 5301 5305 5307 5313 5317 5319 5323 5325 5329 5335 5337 5341 5343 5347 5349 5355 5359 5361 5365 5367 5371 5377 5379 5383 5385 5389 5391 5397 5401 5403 5407 5409 5413 5419 5421 5425 5427 5431 5433 5439 5443 5445 5449 5451 5455 5461 5463 5467 5469 5473 5475 5481 5485 5487 5491 5493 5497 Cuando deberia devolver: 5001 5007 5019 5029 5041 5043 5049 5053 5089 5103 5127 5137 5139 5149 5151 5157 5169 5179 5181 5191 5211 5217 5229 5233 5235 5253 5259 5277 5283 5293 5295 5299 5325 5335 5341 5343 5371 5377 5379 5385 5409 5419 5427 5433 5449 5455 5463 5473 5487 5491 @DessaNo pense que fuera a cambiar tanto el resultado... Ahora pruebalo asi: 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 End 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 s = "" '*PsYkE1* Me.Print "PsYkE1" t1 = GetTickCount For x = 5000 To 7000 If Check_Lucky_Number3(x) Then s = s & x & " " End If Next t2 = GetTickCount Me.Print t2 - t1 & vbNewLine MsgBox s 'LeandroA Me.Print "LeandroA" t1 = GetTickCount For x = 5000 To 7000 If IsLuckyNumber(x) Then s = s & x & " " End If Next t2 = GetTickCount Me.Print t2 - t1 MsgBox s End Sub
Mis resultados: Dessa 2265 *PsYkE1* 1860 LeandroA 1984 DoEvents¡!
|
|
« Última modificación: 15 Agosto 2010, 02:11 am por *PsYkE1* »
|
En línea
|
|
|
|
LeandroA
|
mmm me parece que estas tomando mal mi función yo tengo estos resultados Dessa 2125 PsYkE1 2000 LeandroA 1172 pongo las tres funciones Option Explicit Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long) Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long) 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 End 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 s = "" '*PsYkE1* Me.Print "PsYkE1" t1 = GetTickCount For x = 5000 To 7000 If Check_Lucky_Number3(x) Then s = s & x & " " End If Next t2 = GetTickCount Me.Print t2 - t1 & vbNewLine MsgBox s 'LeandroA Me.Print "LeandroA" t1 = GetTickCount For x = 5000 To 7000 If IsLuckyNumber(x) Then s = s & x & " " End If Next t2 = GetTickCount Me.Print t2 - t1 MsgBox s End Sub 'Dessa Function IsLucky(lngNum As Long) As Boolean Dim x As Long, cont As Long, contStep As Long, Indice As Long, 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 If lngNum = 5 Then Exit Function For x = 1 To lngNum Step 2 ReDim Preserve numLuck(contStep) numLuck(contStep) = x contStep = contStep + 1 Next contStep = 0: cont = 0: Indice = 1 While numLuck(Indice) <= UBound(numLuck) x = -1 While x < UBound(numLuck) x = x + 1 If cont = numLuck(Indice) - 1 Then cont = 0 Else numLuck(contStep) = numLuck(x) cont = cont + 1 contStep = contStep + 1 End If Wend If contStep = numLuck(Indice + 1) Then ReDim Preserve numLuck(contStep - 2) Else ReDim Preserve numLuck(contStep - 1) End If cont = 0 contStep = 0 Indice = Indice + 1 Wend For x = 0 To UBound(numLuck) If numLuck(x) = lngNum Then IsLucky = True Exit For End If Next End Function '-PsYkE1 Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean Dim lTempArray() As Long Dim NextElim As Long Dim lArrayUBound As Long Dim m As Long Dim x As Long If lNumber = 1 Or lNumber = 3 Then GoTo IsLucky ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then m = 1 For x = 1 To lNumber Step 2 ReDim Preserve lTempArray(m) lTempArray(m) = x m = m + 1 Next NextElim = 3: m = 2 Do x = NextElim Do While x <= UBound(lTempArray) lArrayUBound = UBound(lTempArray) If Not x = lArrayUBound Then RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4 ReDim Preserve lTempArray(lArrayUBound - 1) Else Exit Function End If x = x + (NextElim - 1) Loop m = m + 1 NextElim = lTempArray(m) Loop While Not NextElim > lArrayUBound IsLucky: Check_Lucky_Number3 = True End If End Function 'LeandroA Private Function IsLuckyNumber(ByVal Num As Long) As Boolean Dim lCount As Long, lPos As Long, i As Long Dim Arr() As Long If Num < 1 Then Exit Function If Num Mod 2 = 0 Then Exit Function ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2)) For lPos = 1 To Num Step 2 i = i + 1 Arr(i) = lPos Next lCount = 1 Do While UBound(Arr) > lCount lCount = lCount + 1 lPos = Arr(lCount) Do If lPos > UBound(Arr) Then Exit Do If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos) ReDim Preserve Arr(UBound(Arr) - 1) lPos = lPos + Arr(lCount) - 1 Loop If Arr(UBound(Arr)) <> Num Then Exit Function Loop IsLuckyNumber = True End Function
Saludos
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
LA de cobein aun se esta ejecutando, en un siguiente Post pongo el resultado con el de este por que su funcion es ESAGERADAMENTE LENTA ( me tardo 1 minuto, actualmente se esta combrobando las coherencias. )!¡. No se por que demonios pero por hay creo que Spyke y Dessa andan mal o quisas sea Leandro? Lo siguiente comprueba Tiempo y coherencias entre las tres funciones, LeandroA difiere con Spyke y Dessa en algunos numeros, aqui mostrados!¡. Dessa --> 2625 PsYkE1 -- > 2094 LeandroA -- > 1359
Se comprobaran Coherencias...
LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5179 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5191 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5299 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5335 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5371 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5419 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5455 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5491 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5503 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5515 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5527 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5551 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5587 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5599 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5671 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5707 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5719 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5755 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5767 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5803 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5827 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5839 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5851 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5911 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5923 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5959 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 5971 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6019 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6031 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6055 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6079 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6115 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6163 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6175 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6211 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6271 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6331 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6355 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6367 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6379 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6415 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6427 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6463 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6475 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6523 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6535 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6559 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6631 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6667 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6679 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6715 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6763 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6787 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6871 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6883 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) --> 6931
Dulces Lunas!¡.
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
Aqui el proyecto de comprobacion!¡. http://infrangelux.sytes.net/filex/down.php?InfraDown=/BlackZeroX/ComprobacionVel.zip
Dessa --> 2625 PsYkE1 -- > 2078 LeandroA -- > 1375 Cobein -- > 108015
Se comprobaran Coherencias...
LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5179 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5191 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5299 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5335 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5371 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5419 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5455 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5491 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5503 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5515 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5527 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5551 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5587 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5599 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5671 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5707 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5719 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5755 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5767 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5803 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5827 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5839 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5851 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5911 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5923 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5959 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 5971 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6019 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6031 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6055 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6079 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6115 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6163 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6175 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6211 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6271 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6331 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6355 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6367 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6379 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6415 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6427 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6463 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6475 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6523 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6535 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6559 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6631 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6667 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6679 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6715 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6763 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6787 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6871 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6883 LeandroA (Falso) ; Dessa (Verdadero) ; PsYkE1 (Verdadero) ; Cobein (Verdadero) ; --> 6931
Dulces Lunas!¡.
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
Dessa
Desconectado
Mensajes: 624
|
Yo olvidé de agregar un If a mi code, luego pruebo como dice BlackZeroX , por ahora serà así Option Explicit Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long) Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long) 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 End 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 s = "" '*PsYkE1* Me.Print "PsYkE1" t1 = GetTickCount For x = 5000 To 7000 If Check_Lucky_Number3(x) Then s = s & x & " " End If Next t2 = GetTickCount Me.Print t2 - t1 & vbNewLine MsgBox s 'LeandroA Me.Print "LeandroA" t1 = GetTickCount For x = 5000 To 7000 If IsLuckyNumber(x) Then s = s & x & " " End If Next t2 = GetTickCount Me.Print t2 - t1 MsgBox s End Sub 'Dessa Function IsLucky(lngNum As Long) As Boolean Dim x As Long, cont As Long, contStep As Long, Indice As Long, 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 If lngNum = 5 Then Exit Function For x = 1 To lngNum Step 2 ReDim Preserve numLuck(contStep) numLuck(contStep) = x contStep = contStep + 1 Next contStep = 0: cont = 0: Indice = 1 While numLuck(Indice) <= UBound(numLuck) If numLuck(UBound(numLuck)) <> lngNum Then Exit Function x = -1 While x < UBound(numLuck) x = x + 1 If cont = numLuck(Indice) - 1 Then cont = 0 Else numLuck(contStep) = numLuck(x) cont = cont + 1 contStep = contStep + 1 End If Wend If contStep = numLuck(Indice + 1) Then ReDim Preserve numLuck(contStep - 2) Else ReDim Preserve numLuck(contStep - 1) End If cont = 0 contStep = 0 Indice = Indice + 1 Wend For x = 0 To UBound(numLuck) If numLuck(x) = lngNum Then IsLucky = True Exit For End If Next End Function '-PsYkE1 Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean Dim lTempArray() As Long Dim NextElim As Long Dim lArrayUBound As Long Dim m As Long Dim x As Long If lNumber = 1 Or lNumber = 3 Then GoTo IsLucky ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then m = 1 For x = 1 To lNumber Step 2 ReDim Preserve lTempArray(m) lTempArray(m) = x m = m + 1 Next NextElim = 3: m = 2 Do x = NextElim Do While x <= UBound(lTempArray) lArrayUBound = UBound(lTempArray) If Not x = lArrayUBound Then RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4 ReDim Preserve lTempArray(lArrayUBound - 1) Else Exit Function End If x = x + (NextElim - 1) Loop m = m + 1 NextElim = lTempArray(m) Loop While Not NextElim > lArrayUBound IsLucky: Check_Lucky_Number3 = True End If End Function 'LeandroA Private Function IsLuckyNumber(ByVal Num As Long) As Boolean Dim lCount As Long, lPos As Long, i As Long Dim Arr() As Long If Num < 1 Then Exit Function If Num Mod 2 = 0 Then Exit Function ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2)) For lPos = 1 To Num Step 2 i = i + 1 Arr(i) = lPos Next lCount = 1 Do While UBound(Arr) > lCount lCount = lCount + 1 lPos = Arr(lCount) Do If lPos > UBound(Arr) Then Exit Do If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos) ReDim Preserve Arr(UBound(Arr) - 1) lPos = lPos + Arr(lCount) - 1 Loop If Arr(UBound(Arr)) <> Num Then Exit Function Loop IsLuckyNumber = True End Function
|
|
|
En línea
|
Adrian Desanti
|
|
|
|
Tokes
Desconectado
Mensajes: 140
|
Oigan, aquí les dejo mi cuarto intento junto con sus funciones. Option Explicit Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long) Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long) 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 End 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 = "" '*PsYkE1* Me.Print "PsYkE1" t1 = GetTickCount For x = 5000 To 7000 If Check_Lucky_Number3(x) Then s = s & x & " " End If Next t2 = GetTickCount Me.Print t2 - t1 & vbNewLine MsgBox s, vbOKOnly, "PsYkE1" s = "" 'LeandroA Me.Print "LeandroA" t1 = GetTickCount For x = 5000 To 7000 If IsLuckyNumber(x) Then s = s & x & " " End If Next t2 = GetTickCount Me.Print t2 - t1 & vbNewLine MsgBox s, vbOKOnly, "LeandroA" 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, cont As Long, contStep As Long, Indice As Long, 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 If lngNum = 5 Then Exit Function For x = 1 To lngNum Step 2 ReDim Preserve numLuck(contStep) numLuck(contStep) = x contStep = contStep + 1 Next contStep = 0: cont = 0: Indice = 1 While numLuck(Indice) <= UBound(numLuck) If numLuck(UBound(numLuck)) <> lngNum Then Exit Function x = -1 While x < UBound(numLuck) x = x + 1 If cont = numLuck(Indice) - 1 Then cont = 0 Else numLuck(contStep) = numLuck(x) cont = cont + 1 contStep = contStep + 1 End If Wend If contStep = numLuck(Indice + 1) Then ReDim Preserve numLuck(contStep - 2) Else ReDim Preserve numLuck(contStep - 1) End If cont = 0 contStep = 0 Indice = Indice + 1 Wend For x = 0 To UBound(numLuck) If numLuck(x) = lngNum Then IsLucky = True Exit For End If Next End Function '-PsYkE1 Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean Dim lTempArray() As Long Dim NextElim As Long Dim lArrayUBound As Long Dim m As Long Dim x As Long If lNumber = 1 Or lNumber = 3 Then GoTo IsLucky ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then m = 1 For x = 1 To lNumber Step 2 ReDim Preserve lTempArray(m) lTempArray(m) = x m = m + 1 Next NextElim = 3: m = 2 Do x = NextElim Do While x <= UBound(lTempArray) lArrayUBound = UBound(lTempArray) If Not x = lArrayUBound Then RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4 ReDim Preserve lTempArray(lArrayUBound - 1) Else Exit Function End If x = x + (NextElim - 1) Loop m = m + 1 NextElim = lTempArray(m) Loop While Not NextElim > lArrayUBound IsLucky: Check_Lucky_Number3 = True End If End Function 'LeandroA Private Function IsLuckyNumber(ByVal Num As Long) As Boolean Dim lCount As Long, lPos As Long, i As Long Dim Arr() As Long If Num < 1 Then Exit Function If Num Mod 2 = 0 Then Exit Function ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2)) For lPos = 1 To Num Step 2 i = i + 1 Arr(i) = lPos Next lCount = 1 Do While UBound(Arr) > lCount lCount = lCount + 1 lPos = Arr(lCount) Do If lPos > UBound(Arr) Then Exit Do If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos) ReDim Preserve Arr(UBound(Arr) - 1) lPos = lPos + Arr(lCount) - 1 Loop If Arr(UBound(Arr)) <> Num Then Exit Function Loop IsLuckyNumber = 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 Mis resultados son: Dessa --> 12859 PsYkE1 --> 5109 LeandroA --> 3438 Tokes --> 4359 Saludos.
|
|
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Convertidor de número literal a número real
Programación C/C++
|
david_BS
|
0
|
2,434
|
6 Mayo 2012, 21:34 pm
por david_BS
|
|
|
ayuda con un numero que se repita
Programación C/C++
|
daniel010
|
2
|
2,257
|
13 Septiembre 2013, 03:02 am
por GenR_18
|
|
|
saber primer numero y ultimo numero [solucionado]
Bases de Datos
|
basickdagger
|
4
|
4,178
|
3 Septiembre 2014, 17:19 pm
por basickdagger
|
|
|
Generar numeros que contengan un numero dado x
« 1 2 »
Programación C/C++
|
GoBrit
|
13
|
5,261
|
17 Enero 2015, 02:28 am
por engel lex
|
|
|
Invertir un número dado
Programación C/C++
|
BortizF
|
3
|
2,840
|
18 Octubre 2017, 16:20 pm
por BortizF
|
|