je poursuis dans
la lancée avec un générateur de nombres premiers.
je poursuis dans
la lancée avec un générateur de nombres premiers.
je poursuis dans
la lancée avec un générateur de nombres premiers.
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 à 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 à 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
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: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
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
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: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
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: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
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
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: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" a écrit dans le message de news: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: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
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" a écrit dans le message de news: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: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
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 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
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
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
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