nombre premier

Mattttttttttrix

Mattttttttttrix

XLDnaute Junior
salut

Je suis en rtain de peter un plomb :D

En gros, j'essaye de faire un code VBA qui quand je rentre un nombre X, me trouve tout les nombre premiers inferieurs ou egale a X

Sub calculdenombrepremier()
Dim X As Integer
Dim i As Integer
Dim j As Integer

X = Cells(3, 4)

For i = 2 To X
For j = Cells(2, 2) To Range("B65536").End(xlUp)
If i Mod j = 0 And i <> j Then
'quedalle
Else
Cells(1 + i, 2).Value = i
End If
Next j
Next i
End Sub


Voila...
je suis larguer complet, je me perd dans mes idées et je m'en sors pas :mad:
Merci
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re : nombre premier

Bonjour


J'ai été voir chez Dieu le père :How to Get Prime Numbers or Factors

voir la macro Sub GetPrime()
ci-dessous
Code: 
Sub GetFactors()
      Dim Count As Integer
      Dim NumToFactor As Single 'Integer limits to < 32768
      Dim Factor As Single
      Dim y As Single
      Dim IntCheck As Single
   
      Count = 0
      Do
         NumToFactor = _
            Application.InputBox(Prompt:="Type integer", Type:=1)
         'Force entry of integers greater than 0.
         IntCheck = NumToFactor - Int(NumToFactor)
         If NumToFactor = 0 Then
            Exit Sub
            'Cancel is 0 -- allow Cancel.
         ElseIf NumToFactor < 1 Then
            MsgBox "Please enter an integer greater than zero."
         ElseIf IntCheck > 0 Then
            MsgBox "Please enter an integer -- no decimals."
         End If
         'Loop until entry of integer greater than 0.
      Loop While NumToFactor <= 0 Or IntCheck > 0
      For y = 1 To NumToFactor
         'Put message in status bar indicating the integer being checked.
         Application.StatusBar = "Checking " & y
         Factor = NumToFactor Mod y
         'Determine if the result of division with Mod is without _
             remainder and thus a "factor".
         If Factor = 0 Then
            'Enter the factor into a column starting with the active cell.
            ActiveCell.Offset(Count, 0).Value = y
            'Increase the amount to offset for next value.
            Count = Count + 1
         End If
      Next
      'Restore Status Bar.
      Application.StatusBar = "Ready"
   End Sub
   
   [B][COLOR="Blue"]Sub GetPrime()
      Dim Count As Integer
      Dim BegNum As Single  'Integer limits to < 32768
      Dim EndNum As Single
      Dim Prime As Single
      Dim flag As Integer
      Dim IntCheck As Single
      Count = 0
   
      Do
         BegNum = _
            Application.InputBox(Prompt:="Type beginning number.", Type:=1)
         'Force entry of integers greater than 0.
         IntCheck = BegNum - Int(BegNum)
         If BegNum = 0 Then
            Exit Sub
            'Cancel is 0 -- allow Cancel.
         ElseIf BegNum < 1 Then
            MsgBox "Please enter an integer greater than zero."
         ElseIf IntCheck > 0 Then
            MsgBox "Please enter an integer -- no decimals."
         End If
         'Loop until entry of integer greater than 0.
      Loop While BegNum <= 0 Or IntCheck > 0
   
      Do
         EndNum = _
            Application.InputBox(Prompt:="Type ending number.", Type:=1)
         'Force entry of integers greater than 0.
         IntCheck = EndNum - Int(EndNum)
         If EndNum = 0 Then
            Exit Sub
            'Cancel is 0 -- allow Cancel.
         ElseIf EndNum < BegNum Then
            MsgBox "Please enter an integer larger than " & BegNum
         ElseIf EndNum < 1 Then
            MsgBox "Please enter an integer greater than zero."
         ElseIf IntCheck > 0 Then
            MsgBox "Please enter an integer -- no decimals."
         End If
         'Loop until entry of integer greater than 0.
      Loop While EndNum < BegNum Or EndNum <= 0 Or IntCheck > 0
   
      For y = BegNum To EndNum
         flag = 0
         z = 1
         Do Until flag = 1 Or z = y + 1
            'Put message into Status Bar indicating the integer and _
                divisor in each loop.
            Application.StatusBar = y & " / " & z
            Prime = y Mod z
            If Prime = 0 And z <> y And z <> 1 Then
               flag = 1
            End If
            z = z + 1
         Loop
   
         If flag = 0 Then
            'Enter the factor into a column starting with the active cell.
            ActiveCell.Offset(Count, 0).Value = y
            'Increase the amount to offset for next value.
            Count = Count + 1
         End If
      Next y
      'Restore Status Bar.
      Application.StatusBar = "Ready"
   End Sub[/COLOR][/B]
 
Dernière édition:
Vote positif 0 Vote négatif
Gorfael

Gorfael

XLDnaute Barbatruc
Re : nombre premier

Mattttttttttrix à dit:
salut

Je suis en rtain de peter un plomb :D

En gros, j'essaye de faire un code VBA qui quand je rentre un nombre X, me trouve tout les nombre premiers inferieurs ou egale a X

Sub calculdenombrepremier()
Dim X As Integer
Dim i As Integer
Dim j As Integer

X = Cells(3, 4)

For i = 2 To X
For j = Cells(2, 2) To Range("B65536").End(xlUp)
If i Mod j = 0 And i <> j Then
'quedalle
Else
Cells(1 + i, 2).Value = i
End If
Next j
Next i
End Sub


Voila...
je suis larguer complet, je me perd dans mes idées et je m'en sors pas :mad:
Merci
Cliquez pour agrandir...
Salut
Nombre en A1 :
Code: 
Sub test()
Dim X As Long
Dim Y As Long
Dim Z As Long
Dim NP As Range
Set NP = Range("A65536").End(xlUp).Offset(1, 0)
For X = 2 To Range("A1")
    If Range("A1") Mod X = 0 Then
    'X est un diviseur entier
        For Y = 2 To X
            If X Mod Y = 0 And X <> Y Then Exit For
            If X Mod Y = 0 And X = Y Then
                NP = Y
                Set NP = NP.Offset(1, 0)
            End If
        Next Y
    End If
Next X
End Sub
ou décomposition en nombres premiers
Code: 
Sub test_1()
Dim Val_A As Long
Dim X As Long
Dim Y As Long
Dim NP As Range
Set NP = Range("A65536").End(xlUp).Offset(1, 0)
Val_A = Range("A1")
X = 2
Do
    If Val_A Mod X = 0 Then
        For Y = 2 To Val_A
            If Val_A Mod (X ^ Y) > 0 Then
                Y = Y - 1
                Exit For
            End If
        Next Y
        NP = X & " ^ " & Y
        Set NP = NP.Offset(1, 0)
        Val_A = Val_A / (X ^ Y)
    End If
    X = X + 1
Loop Until Val_A = 1
End Sub
A+
 
Dernière édition:
Vote positif 0 Vote négatif
Mattttttttttrix

Mattttttttttrix

XLDnaute Junior
Re : nombre premier

MERCI pierre!!!:)

Je suis ensuite parti sur ceci...

Sub calculdenombrepremier()

Dim X As Integer
Dim i As Integer
Dim j As Integer
Dim y As Integer

X = Cells(3, 4)

ligne1 = Cells(2, 2).Row
Lignemax = Selection.End(xlUp).Select

For i = 2 To X
ipremier = True
For j = ligne To Lignemax
y = Cells(j, 2).Value
If i Mod y = 0 And i <> 0 Then
ipremier = False
End If
Next j
If ipremier = True Then
Lignemax = Lignemax + 1
Cells(Lignemax, 2) = i
End If
Next i

End Sub

Mais ca plante :mad:

je vais fouiller encore un peu!!

J'aime pas rester sur un echec :mad:


Edit : merci a gorfael aussi !!!

Avec tout cela, si j'arrive pas a me faire m'adapter mon code, c'est que je suis un gros nul :mad:

Je vais faire et je poste mon code dés qu'il est OK
 
Dernière édition:
Vote positif 0 Vote négatif
Mattttttttttrix

Mattttttttttrix

XLDnaute Junior
Re : nombre premier

Voila la fin en bidouillant, mais en gardant beaucoup de pierrejean!

C'était mon iodée première au départ, donc j'y reviens!

En fait, c'était tout con.... :rolleyes:

Si j'avais ceci
For j = 1 To Range("A65536").End(xlUp).Row
Je n'aurai pas galéré :rolleyes:

Le code complet et fini

Code: 
Option Explicit
Sub premiers()
Dim i As Integer
Dim j As Integer
Dim Ipremier As Boolean

Cells(1, 1).Value = 2

For i = 2 To Range("B1")
 For j = 1 To Range("A65536").End(xlUp).Row
   If i Mod Cells(j, 1) = 0 Then
     Ipremier = True
     Exit For
   End If
 Next j
If Ipremier = False Then Cells(Range("A65536").End(xlUp).Row + 1, 1) = i
Ipremier = False
Next i
End Sub

Sub initialisation()

Dim k As Integer

For k = 1 To Range("A65536").End(xlUp).Row
Cells(k, 1).Value = ""
Next k

End Sub
 
Vote positif 0 Vote négatif
Gorfael

Gorfael

XLDnaute Barbatruc
Re : nombre premier

Salut Mattttttttttrix
remplace
Code: 
Sub initialisation()
 
Dim k As Integer
 
For k = 1 To Range("A65536").End(xlUp).Row
Cells(k, 1).Value = ""
Next k
 
End Sub
par
Code: 
Sub initialisation()
Range([A1], [A65536].End(xlUp)).ClearContents
End Sub
Ouais, je sais, c'est mesquin :D
A+
 
Vote positif 0 Vote négatif
S

scaramosca

XLDnaute Nouveau
Re : nombre premier

Bonjour,
Je suis un curieux des nombres premiers.
Je viens de voir vos deux classeurs.

Ignorant totalement le VBA, j'ai "construit" mon classeur de nombres premiers.
Vous allez me dire qu'il y avait plus simple, mais je suis au niveau zéro.

j'ai donc dans un fichiers excell, les nombres premiers de 1 à 10000019

Pour cela, il m'as fallu 166 pages

En A1, entrer un nombre
'enter'
et la, s'affiche les nombres entier (qui veux dire que ce n'est pas un nombre premier, mais son diviseur).
Si une case affiche "1", c'est que c'est un nombre premier.

Voici la première page
Je l'ai configurer pour qu'elle fasse les dimensions de mon écran.


J'imagine qu'il y a plus simple, mais comme je l'ai dis plus haut : je ne sais pas comment.

Bonne journée à vous
 

Pièces jointes

  • Nbr premiers.xls
    50.5 KB · Affichages: 110
  • Nbr premiers.xls
    50.5 KB · Affichages: 110
  • Nbr premiers.xls
    50.5 KB · Affichages: 117
Vote positif 0 Vote négatif
KenDev

KenDev

XLDnaute Impliqué
Re : nombre premier

Bonjour à tous,

Sans avoir testé toutes les macros précédentes, un code peut-être plus rapide puisqu'il ne teste que 2 nombres sur six et que la recherche de divisibilité de n s'arrête au delà de racine(n). La liste est construite en colonne 1 de la feuille active. Cordialement

KD

VB: 
Sub PrimeList()
    Dim n&, t&, i&, m%
    n = Cells(Rows.Count, 1).End(xlUp).Row
    If n < 4 Then Cells(1, 1) = 2: Cells(2, 1) = 3: Cells(3, 1) = 5: n = 3
    t = Cells(n, 1): m = t Mod 6
    Do
        t = t + 2 * (1 - (m = 1)): m = 6 - m
        For i = 1 To n
            If Cells(i, 1) > Sqr(t) Then n = n + 1: Cells(n, 1) = t: Exit For
            If t Mod Cells(i, 1) = 0 Then Exit For
        Next i
    Loop
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
223
Compte Supprimé 979
C
cp4
  • Résolu(e)
XL 2010 [RESOLU]Adapter Module de Classe
2
Réponses
29
Affichages
966
cp4
cp4
PORCHER
  • Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
320
TooFatBoy
TooFatBoy
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
124
Phil69970
Phil69970
F
  • Résolu(e)
Microsoft 365 Recherche à partir d'une TextBox
Réponses
4
Affichages
175
Francky79
F
Regueiro
  • Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
304
sylvanu
sylvanu
VBA_dev_Anne_Marie
  • Résolu(e)
Microsoft 365 VBA : somme par colonne
Réponses
9
Affichages
231
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
Sergent_Lipton
  • Résolu(e)
Microsoft 365 [VBA] Barre de recherche dynamique - objectif : cacher les lignes hors résultat
Réponses
3
Affichages
202
Sergent_Lipton
Sergent_Lipton
B
  • Résolu(e)
XL 2013 Comment inversé l'ordre d'enregistrement des lignes dans un tableau
Réponses
6
Affichages
188
bedley
B
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
162
GClaire
G

Membres actuellement en ligne

12 membres et 108 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 335
Messages
2 087 386
Membres
103 531
dernier inscrit
dieubrice