Générateur de nombres premiers

Bonsour® PMO avec ferveur ;o))) vous nous disiez :

je poursuis dans
la lancée avec un générateur de nombres premiers.

;o)))
de Gerard Betremieux IUFM Alsace

'primalite(n en long)en chaine
'réalise la décomposition en facteur premier et renvoi le résultat sous forme de
chaine
'
Function Fact_1er(n As Long) As String
Dim d As Long
Dim r, r1 As String
d = 2
i = 1
Do While n > 1
Do While n Mod d = 0
n = n / d
r = r + CStr(d) + "x"
i = i + 1
Loop
If d = 2 Then d = 3 Else d = d + 2
Loop
If i < 3 Then r1 = "nombre premier" Else r1 = Left(r, Len(r) - 1)
Fact_1er= r1
End Function
'============================================== ' primalité2 Macro
' dans une séléction met en gras les nombres premiers et en italique les autres
Sub primalité2()
For Each x In Selection
n = x.Value
d = 2
i = 1
Do While n > 1
Do While n Mod d = 0
n = n / d
i = i + 1
Loop
If d = 2 Then d = 3 Else d = d + 2
Loop
If i = 2 Then
x.Interior.ColorIndex = 4
x.Interior.Pattern = xlSolid
x.Interior.PatternColorIndex = xlAutomatic

Else
x.Interior.ColorIndex = 2
x.Interior.Pattern = xlSolid
x.Interior.PatternColorIndex = xlAutomatic
End If
Next x
End Sub




--
--
@+
;o)))

Salut PMO,

J'ai déjà pioché sur ce problème.
Essaie ceci sur ta grosse bécane :

Declare Function GetTickCount& Lib "kernel32" ()
Sub Liste()
'Liste des 10 000 premiers nombres premiers
Dim L(1 To 10000, 1 To 2) As Long
Dim n&
Dim duree&
Dim COM As Comment
duree& = GetTickCount&
L(1, 1) = 1: L(1, 2) = 2
L(2, 1) = 2: L(2, 2) = 3
i = 2: n = 3
Do Until i = 10000
n = n + 1
If EstPremier(n) Then
i = i + 1
L(i, 1) = i: L(i, 2) = n
End If
Loop
[A1:B10000] = L
Set COM = [b1].Comment
If COM Is Nothing Then Set COM = [b1].AddComment
COM.Visible = True
COM.Text Text:="Voici les 10 000 premiers nombres premiers" & vbLf & vbLf & _
"Durée en ms : " & GetTickCount& - duree& & ""
End Sub

Function EstPremier(nombre&) As Boolean
'Le plus grand nombre premier détecté
'par cette fonction: 2 147 483 647.
'Le suivant est 2 147 483 659 (#VALEUR!)
If nombre = 2 Or nombre = 3 Then
EstPremier = True
Exit Function
End If
If nombre Mod 2 = 0 Or nombre = 1 Then Exit Function
Dim resultat&: resultat = nombre
Dim n&: n = 3
Do While resultat > n
If nombre Mod n = 0 Then Exit Function
resultat = nombre / n
n = n + 2
Loop
EstPremier = True
End Function

SErge


"PMO" <patrickPOINTmorangeAROBASElapostePOINTnet> a écrit dans le message de news:
67A99993-4146-435B-BAB5-822586A446AD@microsoft.com...

Bonjour à tous,

Serge (Tatanka) m'ayant mis le pied à l'étrier avec les
nombres de Keith et avec les fractales, je poursuis dans
la lancée avec un générateur de nombres premiers.

Voici le code
'****************
'#################################
'### Constante à adapter ###
'### Nombres maximun à balayer ###
Const MAXI As Long = 100000
'#################################
Declare Function GetTickCount& Lib "kernel32" ()

Sub GenereNbPremier()
Dim duree&
Dim TblTop&
Dim g&
Dim i&
Dim j&
Dim k&
Dim T&()
Dim T2() As Variant
Dim COM As Comment
duree& = GetTickCount&
ReDim T&(1 To 2)
T&(1) = 2
T&(2) = 3
TblTop& = 2
For i& = 5 To MAXI Step 2
For j& = 2 To TblTop&
If i& Mod T&(j&) = 0 Then GoTo saut
Next j&
TblTop& = TblTop& + 1
ReDim Preserve T&(1 To TblTop&)
T&(TblTop&) = i&
saut:
Next i&
k& = TblTop& 65536
If k& > 0 And k& * 65536 < TblTop& Then k& = k& + 1
If k& = 0 Then
ReDim T2(1 To TblTop&, 1 To 1)
For i& = 1 To TblTop&
T2(i&, 1) = T&(i&)
Next i&
Range("a1:a" & TblTop& & "") = T2
Else
ReDim T2(1 To 65536, 1 To k&)
j& = 1
g& = 1
For i& = 1 To TblTop&
If i& > TblTop& Then Exit For
If g& > 65536 Then
g& = 1
j& = j& + 1
End If
T2(g&, j&) = T&(i&)
g& = g& + 1
Next i&
Range(Cells(1, 1), Cells(65536, k&)) = T2
End If
Set COM = [a1].Comment
If COM Is Nothing Then Set COM = [a1].AddComment
COM.Visible = True
COM.Text Text:="Pour les " & MAXI & _
" premiers nombres" & vbLf & vbLf & _
"Durée en ms : " & GetTickCount& - duree& & ""
End Sub
'****************

Avec ma machine Core 2 Duo 2.33 GHz j'obtiens les durées
suivantes exprimées en millièmes de seconde :
1) 1359 ms (balayage des 100.000 premiers nombres)
2) 24797ms (balayage des 500.000 premiers nombres)
3) 87063ms (balayage des 1000.000 premiers nombres)
Je n'ai pas fait d'essai plus loin.

Cordialement.

PMO
Patrick Morange

Bonjour Modeste et PMO,

Dans le même ordre d'idée, voici un joli motif
engendré par des nombres premiers entre eux.
1) Insertion / Nom / Définir... :
Noms dans le classeur : premier_entre_eux
Fait référence à : =PGCD(LIGNE();COLONNE())
2) Sélectionner A1:CW101.
3) Mettre largeur de colonne et hauteur de ligne à 5 pixels.
4) Format / Mise en forme conditionnelle... :
La formule est : = premier_entre_eux = 1
Format... :
Motif : Fond noir.

Serge


"Tatanka" <garnote3@ENLEVER.videotron.ca> a écrit dans le message de news: enSfJLZmIHA.2328@TK2MSFTNGP03.phx.gbl...

Salut PMO,

J'ai déjà pioché sur ce problème.
Essaie ceci sur ta grosse bécane :

Declare Function GetTickCount& Lib "kernel32" ()
Sub Liste()
'Liste des 10 000 premiers nombres premiers
Dim L(1 To 10000, 1 To 2) As Long
Dim n&
Dim duree&
Dim COM As Comment
duree& = GetTickCount&
L(1, 1) = 1: L(1, 2) = 2
L(2, 1) = 2: L(2, 2) = 3
i = 2: n = 3
Do Until i = 10000
n = n + 1
If EstPremier(n) Then
i = i + 1
L(i, 1) = i: L(i, 2) = n
End If
Loop
[A1:B10000] = L
Set COM = [b1].Comment
If COM Is Nothing Then Set COM = [b1].AddComment
COM.Visible = True
COM.Text Text:="Voici les 10 000 premiers nombres premiers" & vbLf & vbLf & _
"Durée en ms : " & GetTickCount& - duree& & ""
End Sub

Function EstPremier(nombre&) As Boolean
'Le plus grand nombre premier détecté
'par cette fonction: 2 147 483 647.
'Le suivant est 2 147 483 659 (#VALEUR!)
If nombre = 2 Or nombre = 3 Then
EstPremier = True
Exit Function
End If
If nombre Mod 2 = 0 Or nombre = 1 Then Exit Function
Dim resultat&: resultat = nombre
Dim n&: n = 3
Do While resultat > n
If nombre Mod n = 0 Then Exit Function
resultat = nombre / n
n = n + 2
Loop
EstPremier = True
End Function

SErge


"PMO" <patrickPOINTmorangeAROBASElapostePOINTnet> a écrit dans le message de news:
67A99993-4146-435B-BAB5-822586A446AD@microsoft.com...

Bonjour à tous,

Serge (Tatanka) m'ayant mis le pied à l'étrier avec les
nombres de Keith et avec les fractales, je poursuis dans
la lancée avec un générateur de nombres premiers.

Voici le code
'****************
'#################################
'### Constante à adapter ###
'### Nombres maximun à balayer ###
Const MAXI As Long = 100000
'#################################
Declare Function GetTickCount& Lib "kernel32" ()

Sub GenereNbPremier()
Dim duree&
Dim TblTop&
Dim g&
Dim i&
Dim j&
Dim k&
Dim T&()
Dim T2() As Variant
Dim COM As Comment
duree& = GetTickCount&
ReDim T&(1 To 2)
T&(1) = 2
T&(2) = 3
TblTop& = 2
For i& = 5 To MAXI Step 2
For j& = 2 To TblTop&
If i& Mod T&(j&) = 0 Then GoTo saut
Next j&
TblTop& = TblTop& + 1
ReDim Preserve T&(1 To TblTop&)
T&(TblTop&) = i&
saut:
Next i&
k& = TblTop& 65536
If k& > 0 And k& * 65536 < TblTop& Then k& = k& + 1
If k& = 0 Then
ReDim T2(1 To TblTop&, 1 To 1)
For i& = 1 To TblTop&
T2(i&, 1) = T&(i&)
Next i&
Range("a1:a" & TblTop& & "") = T2
Else
ReDim T2(1 To 65536, 1 To k&)
j& = 1
g& = 1
For i& = 1 To TblTop&
If i& > TblTop& Then Exit For
If g& > 65536 Then
g& = 1
j& = j& + 1
End If
T2(g&, j&) = T&(i&)
g& = g& + 1
Next i&
Range(Cells(1, 1), Cells(65536, k&)) = T2
End If
Set COM = [a1].Comment
If COM Is Nothing Then Set COM = [a1].AddComment
COM.Visible = True
COM.Text Text:="Pour les " & MAXI & _
" premiers nombres" & vbLf & vbLf & _
"Durée en ms : " & GetTickCount& - duree& & ""
End Sub
'****************

Avec ma machine Core 2 Duo 2.33 GHz j'obtiens les durées
suivantes exprimées en millièmes de seconde :
1) 1359 ms (balayage des 100.000 premiers nombres)
2) 24797ms (balayage des 500.000 premiers nombres)
3) 87063ms (balayage des 1000.000 premiers nombres)
Je n'ai pas fait d'essai plus loin.

Cordialement.

PMO
Patrick Morange

Un léger gain de temps :
Inutile de faire écrire le rang du nombre premier trouvé.
Il suffit de regarder le numéro de la ligne.

Sub Liste()
'Liste des 50 000 premiers nombres premiers
Dim L(1 To 50000, 1 To 1) As Long
Dim n&
Dim duree&
Dim COM As Comment
duree& = GetTickCount&
L(1, 1) = 2
L(2, 1) = 3
i = 2: n = 3
Do Until i = 50000
n = n + 1
If EstPremier(n) Then
i = i + 1
L(i, 1) = n
End If
Loop
[A1:A50000] = L
Set COM = [a1].Comment
If COM Is Nothing Then Set COM = [a1].AddComment
COM.Visible = True
COM.Text Text:="Voici les 50 000 premiers nombres premiers" & vbLf & vbLf & _
"Durée en ms : " & GetTickCount& - duree& & ""
End Sub

Serge
"Tatanka" <garnote3@ENLEVER.videotron.ca> a écrit dans le message de news: enSfJLZmIHA.2328@TK2MSFTNGP03.phx.gbl...

Salut PMO,

J'ai déjà pioché sur ce problème.
Essaie ceci sur ta grosse bécane :

Declare Function GetTickCount& Lib "kernel32" ()
Sub Liste()
'Liste des 10 000 premiers nombres premiers
Dim L(1 To 10000, 1 To 2) As Long
Dim n&
Dim duree&
Dim COM As Comment
duree& = GetTickCount&
L(1, 1) = 1: L(1, 2) = 2
L(2, 1) = 2: L(2, 2) = 3
i = 2: n = 3
Do Until i = 10000
n = n + 1
If EstPremier(n) Then
i = i + 1
L(i, 1) = i: L(i, 2) = n
End If
Loop
[A1:B10000] = L
Set COM = [b1].Comment
If COM Is Nothing Then Set COM = [b1].AddComment
COM.Visible = True
COM.Text Text:="Voici les 10 000 premiers nombres premiers" & vbLf & vbLf & _
"Durée en ms : " & GetTickCount& - duree& & ""
End Sub

Function EstPremier(nombre&) As Boolean
'Le plus grand nombre premier détecté
'par cette fonction: 2 147 483 647.
'Le suivant est 2 147 483 659 (#VALEUR!)
If nombre = 2 Or nombre = 3 Then
EstPremier = True
Exit Function
End If
If nombre Mod 2 = 0 Or nombre = 1 Then Exit Function
Dim resultat&: resultat = nombre
Dim n&: n = 3
Do While resultat > n
If nombre Mod n = 0 Then Exit Function
resultat = nombre / n
n = n + 2
Loop
EstPremier = True
End Function

SErge


"PMO" <patrickPOINTmorangeAROBASElapostePOINTnet> a écrit dans le message de news:
67A99993-4146-435B-BAB5-822586A446AD@microsoft.com...

Bonjour à tous,

Serge (Tatanka) m'ayant mis le pied à l'étrier avec les
nombres de Keith et avec les fractales, je poursuis dans
la lancée avec un générateur de nombres premiers.

Voici le code
'****************
'#################################
'### Constante à adapter ###
'### Nombres maximun à balayer ###
Const MAXI As Long = 100000
'#################################
Declare Function GetTickCount& Lib "kernel32" ()

Sub GenereNbPremier()
Dim duree&
Dim TblTop&
Dim g&
Dim i&
Dim j&
Dim k&
Dim T&()
Dim T2() As Variant
Dim COM As Comment
duree& = GetTickCount&
ReDim T&(1 To 2)
T&(1) = 2
T&(2) = 3
TblTop& = 2
For i& = 5 To MAXI Step 2
For j& = 2 To TblTop&
If i& Mod T&(j&) = 0 Then GoTo saut
Next j&
TblTop& = TblTop& + 1
ReDim Preserve T&(1 To TblTop&)
T&(TblTop&) = i&
saut:
Next i&
k& = TblTop& 65536
If k& > 0 And k& * 65536 < TblTop& Then k& = k& + 1
If k& = 0 Then
ReDim T2(1 To TblTop&, 1 To 1)
For i& = 1 To TblTop&
T2(i&, 1) = T&(i&)
Next i&
Range("a1:a" & TblTop& & "") = T2
Else
ReDim T2(1 To 65536, 1 To k&)
j& = 1
g& = 1
For i& = 1 To TblTop&
If i& > TblTop& Then Exit For
If g& > 65536 Then
g& = 1
j& = j& + 1
End If
T2(g&, j&) = T&(i&)
g& = g& + 1
Next i&
Range(Cells(1, 1), Cells(65536, k&)) = T2
End If
Set COM = [a1].Comment
If COM Is Nothing Then Set COM = [a1].AddComment
COM.Visible = True
COM.Text Text:="Pour les " & MAXI & _
" premiers nombres" & vbLf & vbLf & _
"Durée en ms : " & GetTickCount& - duree& & ""
End Sub
'****************

Avec ma machine Core 2 Duo 2.33 GHz j'obtiens les durées
suivantes exprimées en millièmes de seconde :
1) 1359 ms (balayage des 100.000 premiers nombres)
2) 24797ms (balayage des 500.000 premiers nombres)
3) 87063ms (balayage des 1000.000 premiers nombres)
Je n'ai pas fait d'essai plus loin.

Cordialement.

PMO
Patrick Morange

De plus en plus vite ;-)

Sub ListePremiers()
Dim k&, n&, i&, j&, sr&, nnp&
Dim r&()
nnp = Application.InputBox(Prompt:="Entrez n, un nombre entier > 6." _
& vbLf & "Vous obtiendrez la liste dans la plage A1:An." _
& vbLf & "Assurez-vous que la colonne A est vide.", _
Title:=" Liste des n premiers nombres premiers", Default:P00, Type:=1)
If nnp = False Or nnp < 7 Then Exit Sub
duree& = GetTickCount&
Application.ScreenUpdating = False
ReDim r&(1 To nnp, 1 To 1)
r(1, 1) = 2
r(2, 1) = 3
r(3, 1) = 5
r(4, 1) = 7
r(5, 1) = 11
r(6, 1) = 13
k = 6
n = 15
Do
For j = 1 To 8
If j = 1 Then
n = n + 2
ElseIf j = 2 Then n = n + 2
ElseIf j = 3 Then n = n + 4
ElseIf j = 4 Then n = n + 6
ElseIf j = 5 Then n = n + 2
ElseIf j = 6 Then n = n + 6
ElseIf j = 7 Then n = n + 4
ElseIf j = 8 Then n = n + 2
End If
sr = Sqr(n)
For i = 4 To k
If (n Mod r(i, 1)) = 0 Then Exit For
If r(i, 1) >= sr Then
k = k + 1
r(k, 1) = n
If k = nnp Then
Range(Cells(1, 1), Cells(nnp, 1)).Value = r
Application.ScreenUpdating = True
MsgBox "Temps requis : " & GetTickCount& - duree & " ms."
Exit Sub
End If
Exit For
End If
Next i
Next j
n = n + 2
Loop
End Sub

Serge

"Tatanka" <garnote3@ENLEVER.videotron.ca> a écrit dans le message de news: ur28alZmIHA.1680@TK2MSFTNGP06.phx.gbl...

Un léger gain de temps :
Inutile de faire écrire le rang du nombre premier trouvé.
Il suffit de regarder le numéro de la ligne.

Sub Liste()
'Liste des 50 000 premiers nombres premiers
Dim L(1 To 50000, 1 To 1) As Long
Dim n&
Dim duree&
Dim COM As Comment
duree& = GetTickCount&
L(1, 1) = 2
L(2, 1) = 3
i = 2: n = 3
Do Until i = 50000
n = n + 1
If EstPremier(n) Then
i = i + 1
L(i, 1) = n
End If
Loop
[A1:A50000] = L
Set COM = [a1].Comment
If COM Is Nothing Then Set COM = [a1].AddComment
COM.Visible = True
COM.Text Text:="Voici les 50 000 premiers nombres premiers" & vbLf & vbLf & _
"Durée en ms : " & GetTickCount& - duree& & ""
End Sub

Serge
"Tatanka" <garnote3@ENLEVER.videotron.ca> a écrit dans le message de news: enSfJLZmIHA.2328@TK2MSFTNGP03.phx.gbl...

Salut PMO,

J'ai déjà pioché sur ce problème.
Essaie ceci sur ta grosse bécane :

Declare Function GetTickCount& Lib "kernel32" ()
Sub Liste()
'Liste des 10 000 premiers nombres premiers
Dim L(1 To 10000, 1 To 2) As Long
Dim n&
Dim duree&
Dim COM As Comment
duree& = GetTickCount&
L(1, 1) = 1: L(1, 2) = 2
L(2, 1) = 2: L(2, 2) = 3
i = 2: n = 3
Do Until i = 10000
n = n + 1
If EstPremier(n) Then
i = i + 1
L(i, 1) = i: L(i, 2) = n
End If
Loop
[A1:B10000] = L
Set COM = [b1].Comment
If COM Is Nothing Then Set COM = [b1].AddComment
COM.Visible = True
COM.Text Text:="Voici les 10 000 premiers nombres premiers" & vbLf & vbLf & _
"Durée en ms : " & GetTickCount& - duree& & ""
End Sub

Function EstPremier(nombre&) As Boolean
'Le plus grand nombre premier détecté
'par cette fonction: 2 147 483 647.
'Le suivant est 2 147 483 659 (#VALEUR!)
If nombre = 2 Or nombre = 3 Then
EstPremier = True
Exit Function
End If
If nombre Mod 2 = 0 Or nombre = 1 Then Exit Function
Dim resultat&: resultat = nombre
Dim n&: n = 3
Do While resultat > n
If nombre Mod n = 0 Then Exit Function
resultat = nombre / n
n = n + 2
Loop
EstPremier = True
End Function

SErge


"PMO" <patrickPOINTmorangeAROBASElapostePOINTnet> a écrit dans le message de news:
67A99993-4146-435B-BAB5-822586A446AD@microsoft.com...

Bonjour à tous,

Serge (Tatanka) m'ayant mis le pied à l'étrier avec les
nombres de Keith et avec les fractales, je poursuis dans
la lancée avec un générateur de nombres premiers.

Voici le code
'****************
'#################################
'### Constante à adapter ###
'### Nombres maximun à balayer ###
Const MAXI As Long = 100000
'#################################
Declare Function GetTickCount& Lib "kernel32" ()

Sub GenereNbPremier()
Dim duree&
Dim TblTop&
Dim g&
Dim i&
Dim j&
Dim k&
Dim T&()
Dim T2() As Variant
Dim COM As Comment
duree& = GetTickCount&
ReDim T&(1 To 2)
T&(1) = 2
T&(2) = 3
TblTop& = 2
For i& = 5 To MAXI Step 2
For j& = 2 To TblTop&
If i& Mod T&(j&) = 0 Then GoTo saut
Next j&
TblTop& = TblTop& + 1
ReDim Preserve T&(1 To TblTop&)
T&(TblTop&) = i&
saut:
Next i&
k& = TblTop& 65536
If k& > 0 And k& * 65536 < TblTop& Then k& = k& + 1
If k& = 0 Then
ReDim T2(1 To TblTop&, 1 To 1)
For i& = 1 To TblTop&
T2(i&, 1) = T&(i&)
Next i&
Range("a1:a" & TblTop& & "") = T2
Else
ReDim T2(1 To 65536, 1 To k&)
j& = 1
g& = 1
For i& = 1 To TblTop&
If i& > TblTop& Then Exit For
If g& > 65536 Then
g& = 1
j& = j& + 1
End If
T2(g&, j&) = T&(i&)
g& = g& + 1
Next i&
Range(Cells(1, 1), Cells(65536, k&)) = T2
End If
Set COM = [a1].Comment
If COM Is Nothing Then Set COM = [a1].AddComment
COM.Visible = True
COM.Text Text:="Pour les " & MAXI & _
" premiers nombres" & vbLf & vbLf & _
"Durée en ms : " & GetTickCount& - duree& & ""
End Sub
'****************

Avec ma machine Core 2 Duo 2.33 GHz j'obtiens les durées
suivantes exprimées en millièmes de seconde :
1) 1359 ms (balayage des 100.000 premiers nombres)
2) 24797ms (balayage des 500.000 premiers nombres)
3) 87063ms (balayage des 1000.000 premiers nombres)
Je n'ai pas fait d'essai plus loin.

Cordialement.

PMO
Patrick Morange

Bonsoir Modeste et Tatanka,

Ca déménage grave.
Je jette dans les poubelles de l'histoire (et sans regret) ma macro
si lente mais je n'ai pu m'empêcher de bricoler la Sub ListePremiers
de Serge.

Je m'aperçois d'un gain de vitesse si, au lieu d'employer un
tableau bidimensionné comme ReDim r&(1 To nnp, 1 To 1),
on utilise un tableau à 1 dimension et que, par la suite, on le
réaffecte dans un tableau bidmensionné.
En l'état et avec ma machine j'obtiens 797 ms alors qu'avec la
manipulation monodimension puis bidimension j'obtiens 688 ms.

J'ai modifié le code (voir paragraphe '--- Inscription ---) ce qui autorise
d'aller bien au-delà des 65536 premiers nombres (je n'ai pas Excel 2007)
Pour le million de nombres premiers je mets 29125 ms

Voici le code modifié
'****************
Const NBLIGXLMAX As Long = 65536 'nb lignes d'Excel avant Excel 2007

Sub ListePremiers_pmo()
Dim k&, n&, i&, j&, sr&, nnp&, duree&, g&, h&
Dim r&()
Dim T() As Variant
Dim tranche&
Dim RG As Range
Dim couleurs

nnp = Application.InputBox(Prompt:="Entrez n, un nombre entier > 6." _
& vbLf & "Vous obtiendrez la liste dans la plage A1:An.", _
Title:=" Liste des n premiers nombres premiers", Default:P00, Type:=1)
If nnp = False Or nnp < 7 Then Exit Sub
duree& = GetTickCount&
Application.ScreenUpdating = False
ReDim r&(1 To nnp)
r(1) = 2
r(2) = 3
r(3) = 5
r(4) = 7
r(5) = 11
r(6) = 13
k = 6
n = 15
Do
For j = 1 To 8
If j = 1 Then
n = n + 2
ElseIf j = 2 Then n = n + 2
ElseIf j = 3 Then n = n + 4
ElseIf j = 4 Then n = n + 6
ElseIf j = 5 Then n = n + 2
ElseIf j = 6 Then n = n + 6
ElseIf j = 7 Then n = n + 4
ElseIf j = 8 Then n = n + 2
End If
sr = Sqr(n)
For i = 4 To k
If (n Mod r(i)) = 0 Then Exit For
If r(i) >= sr Then
k = k + 1
r(k) = n
If k = nnp Then Exit Do
Exit For
End If
Next i
Next j
n = n + 2
Loop
'--- Inscription ---
Sheets.Add
tranche& = nnp NBLIGXLMAX
If nnp > tranche& * NBLIGXLMAX Then tranche& = tranche& + 1
On Error Resume Next
For h& = 1 To tranche&
ReDim T(1 To NBLIGXLMAX, 1 To 1)
For g& = 1 + NBLIGXLMAX * (h& - 1) To NBLIGXLMAX * h&
T(g& - NBLIGXLMAX * (h& - 1), 1) = r(g&)
Next g&
Set RG = Range(Cells(1, h&), Cells(UBound(T, 1), h&))
RG = T
RG.NumberFormat = "#,##0"
Next h&
couleurs = Array(36, 34)
For h& = tranche& To 1 Step -1
Set RG = Columns(h&)
RG.Interior.ColorIndex = couleurs(h& Mod 2)
Next h&
Application.ScreenUpdating = True
MsgBox "Temps requis : " & GetTickCount& - duree & " ms."
End Sub
'****************

Cordialement.

PMO
Patrick Morange

Salut PMO,

Avec Excel 2003, j'obtiens les 500 000 premiers nombres premiers.
en les inscrivant dans la plage A1:J50000.
J'utilise Time car ma tortue de machine prend 2' 10" pour faire son boulot ;-(
Tu vas sûrement trouver un truc pour accélérer ma macro ;-)
Ce qui me turlupine dans ma macro, c'est mon Select Case !
Vais regarder ta macro plus attentivement sous peu.

A--
Serge

Sub ListePremiers()
'Trouve les 500 000 premiers nombres premiers
Dim k&, n&, i&, j&, sr&
Dim plage As Range
Sheets.Add
ActiveSheet.Name = "Liste_Nombres_Premiers"
Set plage = Range(Cells(1, 1), Cells(50000, 10))
t1 = Time
Application.ScreenUpdating = False
Dim r&(1 To 50000, 1 To 10)
r(1, 1) = 2
r(2, 1) = 3
r(3, 1) = 5
r(4, 1) = 7
r(5, 1) = 11
r(6, 1) = 13
k = 6
n = 15
Do
For j = 1 To 8
If j = 1 Then
n = n + 2
ElseIf j = 2 Then n = n + 2
ElseIf j = 3 Then n = n + 4
ElseIf j = 4 Then n = n + 6
ElseIf j = 5 Then n = n + 2
ElseIf j = 6 Then n = n + 6
ElseIf j = 7 Then n = n + 4
ElseIf j = 8 Then n = n + 2
End If
sr = Sqr(n)
For i = 4 To k
If (n Mod r(i, 1)) = 0 Then Exit For
If r(i, 1) >= sr Then
k = k + 1
Select Case k
Case Is <= 50000: r(k, 1) = n
Case Is <= 100000: r(k - 50000, 2) = n
Case Is <= 150000: r(k - 100000, 3) = n
Case Is <= 200000: r(k - 150000, 4) = n
Case Is <= 250000: r(k - 200000, 5) = n
Case Is <= 300000: r(k - 250000, 6) = n
Case Is <= 350000: r(k - 300000, 7) = n
Case Is <= 400000: r(k - 350000, 8) = n
Case Is <= 450000: r(k - 400000, 9) = n
Case Is <= 500000: r(k - 450000, 10) = n
End Select
If k = 500000 Then
plage.NumberFormat = "#,##0"
plage.ColumnWidth = 12
plage.Value = r
Application.ScreenUpdating = True
MsgBox Format(t1 - Time, "hh:mm:ss"), vbInformation, " Temps requis"
Exit Sub
End If
Exit For
End If
Next i
Next j
n = n + 2
Loop
End Sub


"PMO" <patrickPOINTmorangeAROBASElapostePOINTnet> a écrit dans le message de news:
FE086FE0-7494-41BE-AEAE-EDC2A446A010@microsoft.com...

Bonsoir Modeste et Tatanka,

Ca déménage grave.
Je jette dans les poubelles de l'histoire (et sans regret) ma macro
si lente mais je n'ai pu m'empêcher de bricoler la Sub ListePremiers
de Serge.

Je m'aperçois d'un gain de vitesse si, au lieu d'employer un
tableau bidimensionné comme ReDim r&(1 To nnp, 1 To 1),
on utilise un tableau à 1 dimension et que, par la suite, on le
réaffecte dans un tableau bidmensionné.
En l'état et avec ma machine j'obtiens 797 ms alors qu'avec la
manipulation monodimension puis bidimension j'obtiens 688 ms.

J'ai modifié le code (voir paragraphe '--- Inscription ---) ce qui autorise
d'aller bien au-delà des 65536 premiers nombres (je n'ai pas Excel 2007)
Pour le million de nombres premiers je mets 29125 ms

Voici le code modifié
'****************
Const NBLIGXLMAX As Long = 65536 'nb lignes d'Excel avant Excel 2007

Sub ListePremiers_pmo()
Dim k&, n&, i&, j&, sr&, nnp&, duree&, g&, h&
Dim r&()
Dim T() As Variant
Dim tranche&
Dim RG As Range
Dim couleurs

nnp = Application.InputBox(Prompt:="Entrez n, un nombre entier > 6." _
& vbLf & "Vous obtiendrez la liste dans la plage A1:An.", _
Title:=" Liste des n premiers nombres premiers", Default:P00, Type:=1)
If nnp = False Or nnp < 7 Then Exit Sub
duree& = GetTickCount&
Application.ScreenUpdating = False
ReDim r&(1 To nnp)
r(1) = 2
r(2) = 3
r(3) = 5
r(4) = 7
r(5) = 11
r(6) = 13
k = 6
n = 15
Do
For j = 1 To 8
If j = 1 Then
n = n + 2
ElseIf j = 2 Then n = n + 2
ElseIf j = 3 Then n = n + 4
ElseIf j = 4 Then n = n + 6
ElseIf j = 5 Then n = n + 2
ElseIf j = 6 Then n = n + 6
ElseIf j = 7 Then n = n + 4
ElseIf j = 8 Then n = n + 2
End If
sr = Sqr(n)
For i = 4 To k
If (n Mod r(i)) = 0 Then Exit For
If r(i) >= sr Then
k = k + 1
r(k) = n
If k = nnp Then Exit Do
Exit For
End If
Next i
Next j
n = n + 2
Loop
'--- Inscription ---
Sheets.Add
tranche& = nnp NBLIGXLMAX
If nnp > tranche& * NBLIGXLMAX Then tranche& = tranche& + 1
On Error Resume Next
For h& = 1 To tranche&
ReDim T(1 To NBLIGXLMAX, 1 To 1)
For g& = 1 + NBLIGXLMAX * (h& - 1) To NBLIGXLMAX * h&
T(g& - NBLIGXLMAX * (h& - 1), 1) = r(g&)
Next g&
Set RG = Range(Cells(1, h&), Cells(UBound(T, 1), h&))
RG = T
RG.NumberFormat = "#,##0"
Next h&
couleurs = Array(36, 34)
For h& = tranche& To 1 Step -1
Set RG = Columns(h&)
RG.Interior.ColorIndex = couleurs(h& Mod 2)
Next h&
Application.ScreenUpdating = True
MsgBox "Temps requis : " & GetTickCount& - duree & " ms."
End Sub
'****************

Cordialement.

PMO
Patrick Morange

Bonsoir Serge,

Sur ma machine j'obtiens 13s/14s au lieu de tes 2m 10
avec le code que tu proposes.

Si je fais tourner le code que j'ai modifié en demandant
les 500.000 premiers nombres premiers, j'obtiens
1) 12875 ms avec joliesse (coloration des colonnes)
2) 11468 ms sans joliesse

Conclusion : la lenteur vient de ta machine.

J'ai acheté, il ya moins d'un mois, une machine
chez Dell dont le coût est de 798,27 euros.
Il s'agit d'un Inspiron 530 avec XP Pro et écran
plat 19 pouces panoramique. Si tu possèdes déjà
un écran plat ça minimisera le prix. Si tu optes
pour l'OS Vista premium, tu économisera 80 euros.
Pour ma part, j'ai préféré payer les 80 euros et être
tranquille car Vista n'arrête pas de m'enquiquiner à
vouloir tout contrôler.

Cordialement.

PMO
Patrick Morange

Bonsour® PMO avec ferveur ;o))) vous nous disiez :

Si je fais tourner le code que j'ai modifié en demandant
les 500.000 premiers nombres premiers, j'obtiens
1) 12875 ms avec joliesse (coloration des colonnes)
2) 11468 ms sans joliesse

45031 ms avec joliesse
;o)))

--
--
@+
;o)))