code vba combinaison 5 numéro sur 49

KenDev

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

Bonsoir à tous

Wouahou !!!

KenDev qui s'inspire de mon code= le nirvana
M'enfin ?!? Ce n'est pas un première (et surement pas la dernière), il me semble me souvenir d'un certain fil Tazuku (ou Takuzu?) lancé par Cathy cet été, pour ne mentionner qu'un exemple ou il y a des preuves! Vous êtes bien trop modeste PierreJean.

Peut être rajouter l'option contraire:
1,1 -> tous les tirages
2,2-> SANS tous les n pairs
2,1-> SANS tous les n impairs
si c'est faisable.
On peut remarquer, dans un premier temps, qu'interdire les pairs revient à n'afficher que les impairs et qu'interdire les 1,1 revient à interdire tout (dans ce cas ne pas lancer la sub sera la solution la plus rapide).
Dans un second temps, à partir de a=3, un code ci-dessous sur le modèle du précédent ou par exemple 'Call CombinaExc(35, 4, 1)' affichera les combinaisons de 4 éléments parmi 35 en interdisant les valeurs (1,5,9,13,...,33). Un différence, au lieu de lancer 3,3 pour interdire les multiples de 3, utiliser 3,0.

Cordialement

KD

VB:
Sub CombinaPrm()
    Call CombinaExc(35, 4, 1)
End Sub

Sub CombinaExc(c%, a%, b%)
    Dim nL&, Tb(), Col%
    Dim n1 As Byte, n2 As Byte, n3 As Byte, n4 As Byte, n5 As Byte
    Application.ScreenUpdating = False
    If b < 0 Or b >= a Or a < 1 Then Exit Sub
    Col = 1
    Sheets.Add
    For n1 = 1 To c
        Do
            If n1 Mod a = b Then n1 = n1 + 1
        Loop Until n1 Mod a <> b
        For n2 = n1 + 1 To c
            Do
                If n2 Mod a = b Then n2 = n2 + 1
            Loop Until n2 Mod a <> b
            For n3 = n2 + 1 To c
                Do
                    If n3 Mod a = b Then n3 = n3 + 1
                Loop Until n3 Mod a <> b
                For n4 = n3 + 1 To c
                    Do
                        If n4 Mod a = b Then n4 = n4 + 1
                    Loop Until n4 Mod a <> b
                    For n5 = n4 + 1 To c
                        Do
                            If n5 Mod a = b Then n5 = n5 + 1
                        Loop Until n5 Mod a <> b
                        If n5 <= c Then
                            nL = nL + 1
                            ReDim Preserve Tb(1 To nL)
                            Tb(nL) = n1 & " " & n2 & " " & n3 & " " & n4 & " " & n5
                            If nL = Rows.Count Then
                                Range(Cells(1, Col), Cells(Rows.Count, Col)).Value = Application.Transpose(Tb)
                                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(Tb)
    Application.ScreenUpdating = True
End Sub
ps : Au post 17, correction d'une maladresse en fin de fonction NCmbTxt.
 

julien clerc

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

re a tous peut on modifier le code pour imposé une sélection parmi des numéros choisie ?
ex: for m = ( 10 15 14 19 12 13 14)
for n = ( 20 17 40 8 9 )
etc ....
 

Fo_rum

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

Bonjour,

pierrejean, si je peux me permettre, essaie
Code:
Range(Cells(1, 1), Cells(lig, col)).Value = Application.Transpose(tablo)
en prenant la peine de remplacer

Code:
ReDim tablo(1 To lig, col)
par
ReDim tablo(1 To lig, 1 To col)
C'est la difficulté de redéfinir un tableau à multiples dimensions.
 

pierrejean

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

@ ROGER : j'ai fini par comprendre (veuillez m'excuser)
@ Fo_rum : Merci cela n'expliquait pas tout mais c'est tout a fait judicieux
Code:
Sub comnbinaisons1()
num1 = Array(1, 2, 4, 9, 20, 40, 41)
num2 = Array(3, 5, 8, 15, 43, 44, 45)
num3 = Array(6, 12, 18, 23, 35, 37)
num4 = Array(10, 7, 16, 19, 38, 39, 40)
num5 = Array(31, 32, 33, 34, 42, 25, 26, 27, 28)
rc = Rows.Count
lignes = (UBound(num1) + 1) * (UBound(num2) + 1) * (UBound(num3) + 1) * (UBound(num4) + 1) * (UBound(num5) + 1)
col = Int(lignes / rc) + 1
If col > 1 Then
  lig = rc
Else
  lig = lignes
End If
Dim tablo()
ReDim tablo(1 To lig, 1 To col)
ligne = 1
coln = 1
For n1 = LBound(num1) To UBound(num1)
  For n2 = LBound(num2) To UBound(num2)
    For n3 = LBound(num3) To UBound(num3)
      For n4 = LBound(num4) To UBound(num4)
        For n5 = LBound(num5) To UBound(num5)
         tablo(ligne, coln) = num1(n1) & " " & num2(n2) & " " & num3(n3) & " " & num4(n4) & " " & num5(n5)
         ligne = ligne + 1
         If ligne > rc Then
          ligne = 1
          coln = coln + 1
         End If
        Next
      Next
    Next
  Next
Next
Range(Cells(1, 1), Cells(lig, col)).Value = tablo
End Sub
 

julien clerc

XLDnaute Junior
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 ...)
:confused:
cordialement
 

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
 

KenDev

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

Bonsoir à tous,

Mais enfin c'est qui ce Jean Pierre dont tu nous rabat les oreilles ? Pour le reste, bof.

Cordialement

KD
 
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 édition par un modérateur:

julien clerc

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

salut a tous !
j'ais toujours pas de solution à ma difficulté au poste #46::confused:
merci de votre aides
 

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
 

KenDev

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

Re,

salut a tous !
j'ais toujours pas de solution à ma difficulté au poste #46::confused:
merci de votre aides
Si tu l'as, excepté que tu sembles souhaiter ET un code qui réponde à ta question ET que ce code te plaise esthétiquement.

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
 

Fichiers joints

Discussions similaires


Haut Bas