Ok, gracias a los dos. Yo como veía que Maq77 iba descartando cada vez más múltiplos de primos (2,3,5..) pensé que igual sería mejor usar directamente la criba de Eratostenes


Salu2
Si esta es tu primera visita, por favor visita las Normas y consejos para el uso del foro.
Para empezar a ver mensajes, selecciona el foro que quieres visitar para ver todos los hilos y mensajes que contiene. Sin embargo, para participar en la página, deberás registrarte, rellenando el formulario de registro.
'**************************************************************************************** '* PROYECTO : CALCULA PRIMOS '* CONTENIDO : PERMITE CALCULAR NÚMEROS PRIMOS '* VERSION : 1.1 '* AUTORES : MIGUEL QUINTEIRO PIÑERO / MIGUEL QUINTEIRO FERNANDEZ '* INICIO : 16 DE JUNIO DE 2013 '* ACTUALIZACION : 16 DE JUNIO DE 2013 '**************************************************************************************** Option Explicit Dim miNumero As Currency Dim miRaizEntera As Currency Dim miResto As Integer Dim miPrueba As Currency Dim miDivisor As Currency Dim miIndice As Long Private Sub cmdCalculaPrimo_Click() lstPrimos.Clear lstPrimos.AddItem 2 lstPrimos.AddItem 3 miNumero = Val(txtMeta) For miPrueba = 3 To miNumero Step 2 miRaizEntera = Int(Sqr(miPrueba)) For miIndice = 1 To (lstPrimos.ListCount - 1) lstPrimos.ListIndex = miIndice miDivisor = Val(lstPrimos.Text) If miDivisor > miRaizEntera Then lstPrimos.AddItem miPrueba miIndice = lstPrimos.ListCount - 1 Else miResto = miPrueba Mod miDivisor If miResto = 0 Then miIndice = lstPrimos.ListCount - 1 End If End If Next miIndice Next miPrueba End Sub
Public Num As StringPublic Cant As Single Public Ban As Integer Private Sub Command1_Click() Dim Gap(100001) As Double Open Text1.Text For Input As #4 ant = "1" While Not EOF(4) Line Input #4, primo Num = primo gaps = primo - ant Gap(CSng(gaps)) = Gap(CSng(gaps)) + 1 ant = primo Wend Close #4 For x = 2 To 100000 Step 2 If Gap(x) > 0 Then ngap = x End If If Maxgap <= Gap(x) Then Maxgap = Gap(x) End If Next inix = 10000 iniy = 10000 gapant = Gap(2) a = 4 Do Until a > ngap Line (inix + (a - 2) * 10000 / ngap, iniy - 10000 * gapant / Maxgap)-(inix + a * 10000 / ngap, iniy - 10000 * Gap(a) / Maxgap), &H0& Line (inix + (a - 2) * 10000 / ngap, iniy - 10000 * gapant * (a - 2) / 100000)-(inix + a * 10000 / ngap, iniy - 10000 * Gap(a) * a / 100000), &HFF& gapant = Gap(a) a = a + 2 Loop End Sub Private Sub Command3_Click() Open Text1.Text For Input As #1 While Not EOF(1) Line Input #1, primo Num = primo Numero.Text = Num Wend Close #1 Cant = 0 Do While Cant < CSng(cnt.Text) Ban = 0 ln = Len(Num) ' leo un dato Open Text1.Text For Input As #2 While Not EOF(2) Line Input #2, primo lp = Len(primo) If Divide(Num, primo) Then Ban = Ban + 1 Close #2 GoTo 1 End If Wend Close #2 If Ban = 0 And Num <> 2 Then Open Text1.Text For Append As #3 'Crear el archivo plano Print #3, Num Close #3 If Cant / 10 = Int(Cant / 10) Then Numero.Text = Num Numero.Refresh End If Cant = Cant + 1 End If 1 a = 0 Do Until a = ln x = Mid(Num, ln - a, 1) sig = CInt(x) + 1 If sig = 10 Then If a = ln - 1 Then Num = "10" & Right(Num, ln - 1) Else Num = Left(Num, ln - a - 1) & "0" & Right(Num, a) End If a = a + 1 Else If a = 0 Then Num = Left(Num, ln - a - 1) & sig Else Num = Left(Num, ln - a - 1) & sig & Right(Num, a) End If Exit Do End If Loop Loop MsgBox ("TERMINO") End Sub Public Function Divide(a, B) As Boolean ln = Len(a) lp = Len(B) If CSng(Left(a, 1)) < CSng(Left(B, 1)) Then uso = Len(B) + 1 Else uso = Len(B) End If parte = Mid(a, 1, uso) n = 0 Do Until n > Len(a) - uso E = Int(CSng(parte) / CSng(B)) r = CSng(parte) - CSng(B) * E If n = Len(a) - uso Then If r = 0 Then Divide = True Exit Function Else Divide = False Exit Function End If End If parte = CStr(10 * r + CSng(Mid(a, n + uso + 1, 1))) n = n + 1 Loop End Function
Dejar un comentario: