Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

code vba combinaison 5 numéro sur 49

  • Initiateur de la discussion Initiateur de la discussion julien clerc
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

J

julien clerc

Guest
salut a tous,🙁
je cherche désespérément un code vba pour calculer et afficher toutes combinaisons de 5 numéros sur 49 ! sans doublon!
merci! de votre aides ! 🙁
 
Re : code vba combinaison 5 numéro sur 49

re a pierre jean
ex: 3 numéros parmi ( 16 14 15 12 19 17 18 ...)
2 numéros parmi ( 10 9 8 4 7 ...)
😕
cordialement
 
Re : code vba combinaison 5 numéro sur 49

Bonjour à tous,

En réponse à la question du post 42, une alternative au code de PierreJean. La différence est que l'on peut mettre un même numéro à plusieurs lignes différentes. pas sur qu'il y ai un intérêt mais bon. Mode d'emploi : sur une feuille vierge mettre les n° désirés en première position en première ligne à partir de A1, ceux désirés en 2ème position en 2ème ligne à partir de A2, etc... Attention : pas de contrôles de cohérences des entrées.

exemple :
[table="width: 200, align: center"]
[tr]
[td]1[/td]
[td]4[/td]
[td]7[/td]
[td]42[/td]
[td][/td]
[td][/td]
[/tr]
[tr]
[td]4[/td]
[td]8[/td]
[td]12[/td]
[td]23[/td]
[td][/td]
[td][/td]
[/tr]
[tr]
[td]36[/td]
[td]37[/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[/tr]
[tr]
[td]34[/td]
[td]42[/td]
[td]24[/td]
[td]25[/td]
[td]26[/td]
[td][/td]
[/tr]
[tr]
[td]30[/td]
[td]20[/td]
[td]10[/td]
[td]40[/td]
[td]45[/td]
[td][/td]
[/tr]
[/table]

Cordialement

KD

VB:
Sub hghgfh()
    Call CombinaSel(49)
End Sub
Sub CombinaSel(c%)
'affiche les combinaisons à partir des choix en lignes 1 à 5..
'aucun controles
Dim Mx%, Col%, Tb%(), i%, j%, Tm%(1 To 5), n1%, n2%, n3%, n4%, n5%, Ts$(), nL&
    Application.ScreenUpdating = False
    For i = 1 To 5
        Tm(i) = Cells(i, Columns.Count).End(xlToLeft).Column
        If Tm(i) > Mx Then Mx = Tm(i)
    Next i
    ReDim Tb(1 To 5, 1 To Mx)
    For i = 1 To 5
        For j = 1 To Mx
            Tb(i, j) = Cells(i, j)
    Next j, i
    Col = 1
    Sheets.Add
    For n1 = 1 To Tm(1)
        For n2 = 1 To Tm(2)
            For n3 = 1 To Tm(3)
                For n4 = 1 To Tm(4)
                    For n5 = 1 To Tm(5)
                        If Tb(1, n1) <> Tb(2, n2) And Tb(1, n1) <> Tb(3, n3) And _
                            Tb(1, n1) <> Tb(4, n4) And Tb(1, n1) <> Tb(5, n5) And _
                            Tb(2, n2) <> Tb(3, n3) And Tb(2, n2) <> Tb(4, n4) And _
                            Tb(2, n2) <> Tb(5, n5) And Tb(3, n3) <> Tb(4, n4) And _
                            Tb(3, n3) <> Tb(5, n5) And Tb(4, n4) <> Tb(5, n5) Then
                            nL = nL + 1
                            ReDim Preserve Ts(1 To nL)
                            Ts(nL) = Tb(1, n1) & " " & Tb(2, n2) & " " & Tb(3, n3) & " " & _
                                Tb(4, n4) & " " & Tb(5, n5)
                            If nL = Rows.Count Then
                                Range(Cells(1, Col), Cells(Rows.Count, Col)).Value = Application.Transpose(Ts)
                                Col = Col + 1
                                nL = 0
                            End If
                        End If
                    Next
                Next
            Next
        Next
    Next
    If nL <> 0 Then Range(Cells(1, Col), Cells(nL, Col)).Value = Application.Transpose(Ts)
    Application.ScreenUpdating = True
End Sub
 
Dernière édition:
Re : code vba combinaison 5 numéro sur 49

Re,

Le code du post 47 répond également à la question du post 46. Pour reprendre les données exemples :
3 numéros parmi ( 16 14 15 12 19 17 18 ...)
2 numéros parmi ( 10 9 8 4 7 ...)
Il suffit d'écrire en lignes 1, 2 et 3 : 16 14 15 12 19 17 18
et en lignes 4 et 5 : 10 9 8 4 7

Cordialement

KD

Edit : répond bien à la question mais les combinaisons apparaissent en plusieurs exemplaires. Voir post 60
 
Dernière édition:
Re : code vba combinaison 5 numéro sur 49

re, je ne comprend pas totalement le code ,
si tu pouvais formuler un code ex: num 1, num 2, num 3 = ( 16 14 15 12 19 17 18 )
num 4 , num 5 = (10 9 8 4 7)
Mon code de base est celui de jean pierre #45
merci d'avance
 
Re : code vba combinaison 5 numéro sur 49

Bonjour à tous, félicitation pour ce code combinatoire.
Du bon boulot!
Dans ton exemple:
1 5 7 42
4 8 12 23
36 37
34 42 24 25 26
30 20 10 40 45
comment faire pour éviter que des nombres d'une même ligne soient dans une même combinaison:
ex 1 4 36 40 ok mais 1 5 4 46 34 non OK car 1 et 5 dans la même ligne.
merci de l'info.

Julien veut dire Pierre Jean, Jean Pierre était un membre du Forum, décédé. Respect.
Merci


A+
 
Dernière modification par un modérateur:
Re : code vba combinaison 5 numéro sur 49

Bonjour à tous,

Je ne comprends pas bien la question puisque, sauf erreur non détectée, la sub est prévue pour que deux nombres d'une même ligne ne se retrouvent pas ensemble (sauf si bien sur on fait apparaitre un ou plusieurs nombres à des lignes différentes pour, par exemple, répondre à la dernière question de Julien). Je viens de lancer la sub avec ton exemple (tu as modifié le premier 4 en 5) et je n'ai aucune combinaison 1, 5.
Si tu rencontres effectivement un bug, merci de fournir les entrées et au moins une combinaison fautive.
Je ne l'avais pas précisé mais il est évident qu'une combinaison ne contiendra jamais deux fois le même nombre même si celui ci apparait à toutes les lignes.

Julien veut dire Pierre Jean, Jean Pierre était un membre du Forum, décédé. Respect.
J'avais bien compris ce que voulait dire Julien, je voulais simplement lui faire remarquer de façon souriante qu'il s'était encore fourvoyé avec le prénom. En aucun cas il ne s'agissait de manquer de respect à un Jean Pierre, quel qu'il soit. Je profite néanmoins de ton message pour adresser mes meilleures pensées à Jean Pierre que je n'ai malheureusement jamais eu le loisir de croiser ici.

Cordialement

KD
 
Re : code vba combinaison 5 numéro sur 49

re kendev,
je suis perdu voici : mon code merci de jeter un coup d'oeil

Sub CombinaSel(c%)
1,2,3 = 22 18 29 7 28 12 35 3 26 32 15 19 4 21 2 25
4 , 5 = 27 13 36 11 30 8 23 10 5 24 16 33
Dim Mx%, Col%, Tb%(), i%, j%, Tm%(1 To 5), n1%, n2%, n3%, n4%, n5%, Ts$(), nL&
Application.ScreenUpdating = False
For i = 1 To 5
Tm(i) = Cells(i, Columns.Count).End(xlToLeft).Column
If Tm(i) > Mx Then Mx = Tm(i)
Next i
ReDim Tb(1 To 5, 1 To Mx)
For i = 1 To 5
For j = 1 To Mx
Tb(i, j) = Cells(i, j)
Next j, i
Col = 1
Sheets.Add
For n1 = 1 To Tm(1)
For n2 = 1 To Tm(2)
For n3 = 1 To Tm(3)
For n4 = 1 To Tm(4)
For n5 = 1 To Tm(5)
If Tb(1, n1) <> Tb(2, n2) And Tb(1, n1) <> Tb(3, n3) And _
Tb(1, n1) <> Tb(4, n4) And Tb(1, n1) <> Tb(5, n5) And _
Tb(2, n2) <> Tb(3, n3) And Tb(2, n2) <> Tb(4, n4) And _
Tb(2, n2) <> Tb(5, n5) And Tb(3, n3) <> Tb(4, n4) And _
Tb(3, n3) <> Tb(5, n5) And Tb(4, n4) <> Tb(5, n5) Then
nL = nL + 1
ReDim Preserve Ts(1 To nL)
Ts(nL) = Tb(1, n1) & " " & Tb(2, n2) & " " & Tb(3, n3) & " " & _
Tb(4, n4) & " " & Tb(5, n5)
If nL = Rows.Count Then
Range(Cells(1, Col), Cells(Rows.Count, Col)).Value = Application.Transpose(Ts)
Col = Col + 1
nL = 0
End If
End If
Next
Next
Next
Next
Next
If nL <> 0 Then Range(Cells(1, Col), Cells(nL, Col)).Value = Application.Transpose(Ts)
Application.ScreenUpdating = True
End Sub
merci d'avance
 
Re : code vba combinaison 5 numéro sur 49

Re,

Julien :
Il suffit d'écrire en lignes 1, 2 et 3 : 16 14 15 12 19 17 18
et en lignes 4 et 5 : 10 9 8 4 7

Il s'agit des lignes d'une feuille vierge, en aucun cas je demande d'aller rajouter des lignes dans le code. Voir le classeur joint. Attention dans ton exemple il y a 443520 combinaisons.

Cordialement

KD

Edit : Il y a effectivement un soucis, 443520 est beaucoup trop, il devrait y avoir C(16;3)*C(12;2)=36960. Toutes les combinaisons sont là mais en plusieurs exemplaires. Je m'y remet. -> post 60
 
Dernière édition:
Re : code vba combinaison 5 numéro sur 49

Re,

A priori (...) ça devrait être ok. Testé avec tes données exemples et avec un essai avec 5 lignes contenant toutes des n° différents. Cette version devrait fonctionner dans ces deux cas (sous réserve que les lignes identiques sont bien les unes sous les autres). Voir fichier. Avec mes excuses pour les tests insuffisants.

Cordialement

KD

VB:
Option Explicit

Sub hghgfh()
    Call CombinaSel2(49)
End Sub

Sub CombinaSel2(c%)
'affiche les combinaisons à partir des choix en lignes 1 à 5.
'aucun controles de cohérence des entrées
'Que des n° différents OU certaines lignes identiques les unes sous les autres
Dim Mx%, Col%, Tb%(), i%, j%, Tm%(1 To 5), n1%, n2%, n3%, n4%, n5%, Ts$(), nL&, b(1 To 5) As Boolean, d%(1 To 4)
    Application.ScreenUpdating = False
    For i = 1 To 5
        Tm(i) = Cells(i, Columns.Count).End(xlToLeft).Column
        If Tm(i) > Mx Then Mx = Tm(i)
    Next i
    ReDim Tb(1 To 5, 1 To Mx)
    For i = 1 To 5
        b(1) = True
        For j = 1 To Mx
            Tb(i, j) = Cells(i, j)
            If i > 1 And b(1) Then
                If Tb(i, j) <> Tb(i - 1, j) Then b(1) = False
            End If
        Next j
        If i > 1 And b(1) Then b(i) = True
    Next i
    Col = 1
    Sheets.Add
    For n1 = 1 To Tm(1)
        If b(2) Then d(1) = n1 + 1 Else d(1) = 1
        For n2 = d(1) To Tm(2)
            If b(3) Then d(2) = n2 + 1 Else d(2) = 1
            For n3 = d(2) To Tm(3)
                If b(4) Then d(3) = n3 + 1 Else d(3) = 1
                For n4 = d(3) To Tm(4)
                    If b(5) Then d(4) = n4 + 1 Else d(4) = 1
                    For n5 = d(4) To Tm(5)
                        If Tb(1, n1) <> Tb(2, n2) And Tb(1, n1) <> Tb(3, n3) And _
                            Tb(1, n1) <> Tb(4, n4) And Tb(1, n1) <> Tb(5, n5) And _
                            Tb(2, n2) <> Tb(3, n3) And Tb(2, n2) <> Tb(4, n4) And _
                            Tb(2, n2) <> Tb(5, n5) And Tb(3, n3) <> Tb(4, n4) And _
                            Tb(3, n3) <> Tb(5, n5) And Tb(4, n4) <> Tb(5, n5) Then
                            nL = nL + 1
                            ReDim Preserve Ts(1 To nL)
                            Ts(nL) = Tb(1, n1) & " " & Tb(2, n2) & " " & Tb(3, n3) & " " & _
                                Tb(4, n4) & " " & Tb(5, n5)
                            If nL = Rows.Count Then
                                Range(Cells(1, Col), Cells(Rows.Count, Col)).Value = Application.Transpose(Ts)
                                Col = Col + 1
                                nL = 0
                            End If
                        End If
                    Next
                Next
            Next
        Next
    Next
    If nL <> 0 Then Range(Cells(1, Col), Cells(nL, Col)).Value = Application.Transpose(Ts)
    Application.ScreenUpdating = True
End Sub
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2013 Annulé
Réponses
6
Affichages
269
Réponses
15
Affichages
416
Réponses
18
Affichages
346
Réponses
2
Affichages
174
Réponses
6
Affichages
246
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…