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

Re,

On a parfois besoin (du moins cela m'est arrivé) d'une seule combinaison ou d'un sous ensemble de combinaisons. A cet effet la fonction qui suit permet d'obtenir la n ième combinaison sans calculer toutes les combinaisons précédentes.
Avec a et b en paramètre, la première version renvoie un tableau 0 to b ou les indices 1 à b contiennent les n°. En cas d'erreur de paramétrage le tableau ne contient que tb(0). La seconde renvoie un string pour être utilisé sur une feuille de calcul ou, en précisant le terme recherché ne renvoie que celui ci.

Cordialement

KD

exemples:
Code:
Tb=NCmb(49,5,65522) renvoie Tb(0)=0, Tb(1)=1, Tb(2)=6, Tb(3)=16, Tb(4)=29, Tb(5)=47

Code:
=NCmbTxt(49,5,65522) renvoie "1 6 16 29 47"

Code:
=NCmbTxt(49,5,65522, 4) renvoie 29




VB:
Option Explicit

Function NCmb(a&, b&, ByVal c&) As Long()
'renvoie la c ième combinaison de combin(a,b)
Dim Tb&(), i&, bS As Boolean, x&, NbCmb#, cB&
    NbCmb = WorksheetFunction.Combin(a, b)
    If NbCmb > 2147483647 Or b > a Or b < 1 Or c < 1 Or c > NbCmb Then
        ReDim Tb(0 To 0)
    Else
        ReDim Tb(0 To b)
        Do
            cB = cB + 1
            x = 0: bS = False
            For i = a - 1 - Tb(cB - 1) To b - cB Step -1
                x = x + WorksheetFunction.Combin(i, b - cB)
                If c <= x Then
                    bS = True
                    Exit For
                End If
            Next i
            Tb(cB) = a - i
            c = c - (x - WorksheetFunction.Combin(i, b - cB))
        Loop Until cB = b
    End If
    NCmb = Tb
End Function

Function NCmbTxt(a&, b&, ByVal c&, Optional v)
'renvoie la c ième combinaison de combin(a,b)
'avec v renseigné renvoie le vième terme de la cième combinaison
Dim Tb&(), i&, bS As Boolean, x&, NbCmb&, cB&
    NbCmb = WorksheetFunction.Combin(a, b)
    If NbCmb > 2147483647 Or b > a Or b < 1 Or c < 1 Or c > NbCmb Then
        NCmbTxt = "Erreur"
        Exit Function
    Else
        ReDim Tb(0 To b)
        Do
            cB = cB + 1
            x = 0: bS = False
            For i = a - 1 - Tb(cB - 1) To b - cB Step -1
                x = x + WorksheetFunction.Combin(i, b - cB)
                If c <= x Then
                    bS = True
                    Exit For
                End If
            Next i
            Tb(cB) = a - i
            c = c - (x - WorksheetFunction.Combin(i, b - cB))
        Loop Until cB = b
    End If
    If Not IsMissing(v) Then
        If v > 0 And v <= b Then
            NCmbTxt = Tb(v)
        End If
    Else
        NCmbTxt = Tb(1)
        For i = 2 To b
            NCmbTxt = NCmbTxt & " " & Tb(i)
        Next i
    End If
End Function
 
Dernière édition:
J

JJ1

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

Bonsoir à tous,

Bravo pour ces macros "au poil" comme le souligne Roger !
à KenDev: ta phrase "Effectivement les 'tous pairs' sont en retard (4 occurances sur 12 attendues) mais les tous impairs en avance (16 occurences sur 15 attendues)" : attendues pourquoi? Quelle probabilité? merci
Bonne soirée à tous.
Poil de carotte !
 
Dernière modification par un modérateur:

KenDev

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

Re bonsoir à tous,

@JJ1
Il y a Combin(49,5) combinaisons possibles au total.
Il y a Combin(24,5) combinaisons possibles au total ne comportant que des n° pairs.
La probabilité d'apparition d'une 'tous pairs' est donc Combin(24,5)/Combin(49,5).
Au bout de 536 tirages, si le hasard se comportait de façon prévisible (...), on devrait avoir 536*Combin(24,5)/Combin(49,5) [=11,9473151] tirages tous pairs.

Cordialement

KD

Edit : Pour les "tous impairs' c'est Combin(25,5)
 

julien clerc

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

saluts a tous effectivement , l'apparition d'une combinaison tous paire est attendu mais le hasard
à des règles que excel ne maîtrise pas encore :)
pour le reste j'essaye de modifier macro pour afficher combin =(49;5 ) tous paire ,
sans succès.:(
 

pierrejean

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

Re

Teste ceci

Code:
Sub combinaisons()
lin = 1
col = 1
For m = 1 To 49
 For n = m + 1 To 49
     For o = n + 1 To 49
          For p = o + 1 To 49
               For q = p + 1 To 49
                 If (m Mod 2 = 0) And (n Mod 2 = 0) And (o Mod 2 = 0) And (p Mod 2 = 0) And (q Mod 2 = 0) Then
                   Cells(lin, col) = m & " " & n & " " & " " & o & " " & p & " " & q
                   lin = lin + 1
                   If lin > 65536 Then
                     col = col + 1
                     lin = 1
                   End If
                  End If
                Next q
          Next p
     Next o
 Next n
Next m
End Sub

et ne te precipite pas pour dire : ça marche
 

Fo_rum

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

Bonjour,

tous pairs ? A tester :
Code:
Sub combinaisonsPaires()
  Dim nL As Long, Pair()
  Dim n1 As Byte, n2 As Byte, n3 As Byte, n4 As Byte, n5 As Byte
  Columns(1).Delete
  For n1 = 2 To 48 Step 2
    For n2 = n1 + 2 To 48 Step 2
      For n3 = n2 + 2 To 48 Step 2
        For n4 = n3 + 2 To 48 Step 2
          For n5 = n4 + 2 To 48 Step 2
            nL = nL + 1
            ReDim Preserve Pair(1 To nL)
            Pair(nL) = n1 & " " & n2 & " " & n3 & " " & n4 & " " & n5
          Next
        Next
      Next
    Next
  Next
  Range("A1:A" & nL).Value = Application.Transpose(Pair)
End Sub
 

KenDev

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

Bonjour à tous,

A partir du code posté par Fo_rum, une proposition pour éviter de trop multiplier les codes. Valable uniquement pour les loteries à 5 boules.
Changer les paramètres de 'Call Combina(49, 1, 1)' selon les besoins (49 est évident) :
1,1 -> tous les tirages
2,2-> tous les n pairs
2,1-> tous les n impairs
3,3 -> tous les n divisibles par 3
3,2 -> tous les (n+1) divisibles par 3
3,1 -> tous les (n+2) divisibles par 3 etc.

Cordialement

KD

Edit : correction du code après relecture de celui à PierreJean, le coe précédent ne prévoyant pas plus d'une colonne.

VB:
Sub Combina49Prm5()
    Call Combina(49, 2, 1)
End Sub

Sub Combina(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 < 1 Or b > a Or a < 1 Then Exit Sub
  Col = 1
  Sheets.Add
  For n1 = b To c Step a
    For n2 = n1 + a To c Step a
      For n3 = n2 + a To c Step a
        For n4 = n3 + a To c Step a
          For n5 = n4 + a To c Step a
            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
            Else
            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
 
Dernière édition:
J

JJ1

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

Re bonjour à tous,

oui hélas, Jean Pierre ne verra pas ces codes.Ca l'aurait inspiré.
Merci aussi à Kendev pour sa macro "généraliste". Top !

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.
En tout cas merci et bon am
 

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.
 

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
 

Discussions similaires

Réponses
6
Affichages
258

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib