1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
|
Dim Nombre() As Byte
Dim Maxi As Long
'---------------------------------------------------------------------------------------
Sub NombresPremiersJusqua(n As Long)
'---------------------------------------------------------------------------------------
Dim d As Long, y As Long
' Dimensionnement de la mémoire qui contiendra les nombres analysés:
Maxi = n / 30
ReDim Nombre(1 To 8, 0 To Maxi) As Byte
' Traitement du crible Eratosthene en base 30 sur les colonnes:
Eratosthene_30 1, n
Eratosthene_30 7, n
Eratosthene_30 11, n
Eratosthene_30 13, n
Eratosthene_30 17, n
Eratosthene_30 19, n
Eratosthene_30 23, n
Eratosthene_30 29, n
' Affichage sur une feuille Excel (manque les premiers 1,3,5,7,11,13,17,19,23,29):
y = 10
For d = 1 To Maxi
If Nombre(1, d) = 0 Then y = y + 1: Cells(y, "B") = d * 30 + 1
If Nombre(2, d) = 0 Then y = y + 1: Cells(y, "B") = d * 30 + 7
If Nombre(3, d) = 0 Then y = y + 1: Cells(y, "B") = d * 30 + 11
If Nombre(4, d) = 0 Then y = y + 1: Cells(y, "B") = d * 30 + 13
If Nombre(5, d) = 0 Then y = y + 1: Cells(y, "B") = d * 30 + 17
If Nombre(6, d) = 0 Then y = y + 1: Cells(y, "B") = d * 30 + 19
If Nombre(7, d) = 0 Then y = y + 1: Cells(y, "B") = d * 30 + 23
If Nombre(8, d) = 0 Then y = y + 1: Cells(y, "B") = d * 30 + 29
Next d
End Sub
'---------------------------------------------------------------------------------------
Private Sub Eratosthene_30(U As Byte, n As Long)
'---------------------------------------------------------------------------------------
Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte, f As Byte, g As Byte, h As Byte
Dim i As Long, j As Integer, m As Byte
Dim z As Variant, y As Long
z = CDec(z)
' Mémoires pour le décalage des lignes:
Dim Décal(0 To 7) As Long
Dim base
base = Array(6, 10, 12, 16, 18, 22, 28, 30)
' Ne pas tenir compte du débordement dans le mémoire Nombre():
On Error Resume Next
' Initilialisation des colonnes concernées:
Select Case U
Case 1: a = 2: b = 3: c = 4: d = 5: e = 6: f = 7: g = 8: h = 1: j = 1
Case 7: a = 6: b = 5: c = 1: d = 8: e = 4: f = 3: g = 7: h = 2: j = 0
Case 11: a = 5: b = 1: c = 7: d = 2: e = 8: f = 4: g = 6: h = 3: j = 0
Case 13: a = 1: b = 7: c = 6: d = 3: e = 2: f = 8: g = 5: h = 4: j = 0
Case 17: a = 8: b = 2: c = 3: d = 6: e = 7: f = 1: g = 4: h = 5: j = 0
Case 19: a = 4: b = 8: c = 2: d = 7: e = 1: f = 5: g = 3: h = 6: j = 0
Case 23: a = 3: b = 4: c = 8: d = 1: e = 5: f = 6: g = 2: h = 7: j = 0
Case 29: a = 7: b = 6: c = 5: d = 4: e = 3: f = 2: g = 1: h = 8: j = 0
End Select
' Calcul du décalage pour l'unité passée en argument:
z = j * 30 + U
Décal(0) = Int((z * 7) / 30) - j
Décal(1) = Int((z * 11) / 30) - j
Décal(2) = Int((z * 13) / 30) - j
Décal(3) = Int((z * 17) / 30) - j
Décal(4) = Int((z * 19) / 30) - j
Décal(5) = Int((z * 23) / 30) - j
Décal(6) = Int((z * 29) / 30) - j
Décal(7) = z
' Boucle sur les nombres de l'unitée:
For i = j To (Sqr(n) / 30) + 1
' Crible:
y = i
Do
Nombre(a, y + Décal(0)) = 1
Nombre(b, y + Décal(1)) = 1
Nombre(c, y + Décal(2)) = 1
Nombre(d, y + Décal(3)) = 1
Nombre(e, y + Décal(4)) = 1
Nombre(f, y + Décal(5)) = 1
Nombre(g, y + Décal(6)) = 1
Nombre(h, y + Décal(7)) = 1
y = y + Décal(7)
Loop While y < Maxi
' Nouveau décalage:
For m = 0 To 7
Décal(m) = Décal(m) + base(m)
Next m
Next i
End Sub
'---------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------- |
Partager