code vba combinaison 5 numéro sur 49

julien clerc

XLDnaute Junior
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 ! :(
 

KenDev

XLDnaute Impliqué
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 :
14742
481223
3637
3442242526
3020104045

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:

KenDev

XLDnaute Impliqué
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:

julien clerc

XLDnaute Junior
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
 
J

JJ1

Guest
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:

KenDev

XLDnaute Impliqué
Re : code vba combinaison 5 numéro sur 49

Bonjour à tous,

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.
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
 

julien clerc

XLDnaute Junior
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
 

KenDev

XLDnaute Impliqué
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:

KenDev

XLDnaute Impliqué
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

  • AffCmb.xls
    46 KB · Affichages: 156

Discussions similaires

Réponses
6
Affichages
256

Statistiques des forums

Discussions
311 712
Messages
2 081 802
Membres
101 819
dernier inscrit
lukumubarth