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

gilbert_RGI

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

un truc comme ceci :cool:
de A2 à A50 mettre les 49 numéros
puis lancer la macro

Code:
Sub tirerplus()
    Dim chiffre(0 To 100)
    Sheets(1).Select
    y = Sheets(1).Range("A100").End(xlUp).Row
    Range("b1:B65536").ClearContents
    [B1] = "Tirage Aléa"
    For i = 0 To 4 'y - 1
        Randomize
boucle:
        For x = 0 To y - 1
            chiffre(x) = Cells(2 + x, 1).Value
        Next
        monrnd = Int(Rnd * y)
        For Change = 2 To y
            If chiffre(monrnd) = Cells(Change, 2).Value Then GoTo boucle
            For j = 1 To 5
            If chiffre(monrnd) = Cells(Change, 2).Value + j Then GoTo boucle
            If chiffre(monrnd) = Cells(Change, 2).Value - j Then GoTo boucle
            Next
        Next
        Range("B100").End(xlUp).Offset(1, 0).Value = (chiffre(monrnd))
    Next
End Sub
 

pierrejean

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

Bonjour julien clerc

Salut Gilbert_RGI

Avec un peu de patience:

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
                   Cells(lin, col) = m & " " & n & " " & " " & o & " " & p & " " & q
                   lin = lin + 1
                   If lin > 65536 Then
                     col = col + 1
                     lin = 1
                   End If
                Next q
          Next p
     Next o
 Next n
Next m
End Sub
 

julien clerc

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

bonjour pierre jean
j'ai trouvé une vba sur le forum qui marche trés bien mais on augmentent progréssivement le nombre de combinaison ex:combi 20;5) puis 30;5 le problème est que arrivé a (43;5) j'ai le message suivent: erreur d'exécution '1004' :

Erreur définie par l'application ou par l'objet.

merci de votre aide
voici la vba :
Code :
Sub Extraction()
Dim n1%, n2%, n3%, n4%, n5%, t() As Integer
Dim L As Long

ReDim t(WorksheetFunction.Combin(18, 5) - 1, 4)

For n1 = 1 To 14
For n2 = n1 + 1 To 15
For n3 = n2 + 1 To 16
For n4 = n3 + 1 To 17
For n5 = n4 + 1 To 18

t(L, 0) = n1: t(L, 1) = n2: t(L, 2) = n3: t(L, 3) = n4: t(L, 4) = n5
L = L + 1

Next n5, n4, n3, n2, n1

Feuil1.[A1:E1].Resize(L) = t

End Sub
 
Dernière édition:

phlaurent55

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

Bonjour à tous,
j'ai trouvé une vba sur le forum qui marche trés bien mais on augmentent progréssivement le nombre de combinaison ex:combi 20;5) puis 30;5 le problème est que arrivé a (43;5) j'ai le message suivent: erreur d'exécution '1004' :
=COMBIN(49;5) donne le résultat 1906884

alors que ta feuille (version 2007) permet "seulement" 1048576 lignes
la solution de Pierre-Jean au post#3 est prévue pour mettre les résultats en colonnes


à+
Philippe
 
Dernière édition:

julien clerc

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

oopss un petit problème en utilisant e code de pierre jean il 65536 lignes et 29 colonnes
=COMBIN(49;5) donne le résultat 1906884
65536 * 29 = 1900554
??????
 

pierrejean

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

Re

Tu n'as pas très bien regardé le resultat !!
Il y a 29 colonnes pleines plus lacolonne AD jusqu'a la ligne 6340
ce qui fait bien 29*65536+6340=1906884

Et je me serais bien passé de faire ce controle
 

julien clerc

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

je suis franchement désolé pour le dérangement , faute stupide de ma part.
grand merci a pierre jean . votre présence sur le forum est essentiel .
merci et encore désolé .
 

julien clerc

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

bonjour à tous !
j'aimerais supprimer toute les combinaison avec 5 numéros pairs sur la précédente vba
sans succès! :confused:
merci de votre aides !
 
J

JJ1

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

Bonjour Julien clerc, Pierrot, Pierre jean, Philippe,
Et pourquoi pas 5 numéros impairs?

Tu devrais pas mal d'info de ces es codes dans le lien de Pierrot.

A+
 

pierrejean

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

Re

avec encore un peu plus de patience:

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 Or n Mod 2 <> 0 Or o Mod 2 <> 0 Or p Mod 2 <> 0 Or 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
 

ROGER2327

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

Bonjour à tous


À pierrejean : on peut faire un poil (au pif ? pâle ?) plus rapide avec un tableau. J'en profite pour adapter votre procédure aux différentes tailles de feuille.
VB:
Sub combinaisons()
Dim lin&, col&, rc&, m%, n%, o%, p%, q%, tir$()
lin = 1
col = 0
rc = Rows.Count
ReDim tir(1 To rc, 0)
    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) + (n Mod 2) + (o Mod 2) + (p Mod 2) + (q Mod 2) <> 0 Then '***
                            tir(lin, col) = m & " " & n & " " & o & " " & p & " " & q
                            lin = lin + 1
                            If lin > rc Then
                                col = col + 1
                                lin = 1
                                ReDim Preserve tir(1 To rc, col)
                            End If
                        End If '***
                    Next q
                Next p
            Next o
        Next n
    Next m
    Range(Cells(1, 1), Cells(rc, col + 1)).Value = tir
End Sub


ROGER2327
#5610


Vendredi 13 Pédale 139 (Sainte Valburge - fête Suprême Quarte)
17 Ventôse An CCXX, 5,8664h - doronic
2012-W10-3T14:04:45Z
 
Dernière édition:

pierrejean

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

Re

Merci ROGER
J'apprecie notamment la façon d'affecter le tableau final
 

KenDev

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

Bonsoir à tous,

Dans la configuration 49,5, un code 2 fois plus rapide que la première version de Pierre-Jean et 2,66 fois plus lent que la version Pierre-Jean & Roger mais qui a l'avantage d'être 'universel' si les deux variables 49 et 5 sont susceptibles de varier.

Cordialement

KD

ps : Ou l'on apprend que Roger a le poil épais.

VB:
Option Explicit

Sub test()
    Call AffComb(49, 5)
End Sub

Sub AffComb(a&, b&)
Dim i#, NbCmb#, Rg As Range, Tb(), j%, NbWrt#, NbRw&, m%, c%, Tc&(), s&
    If b > a Or b < 1 Or b > Columns.Count Then Exit Sub
    Application.ScreenUpdating = False: m = Application.Calculation: Application.Calculation = xlCalculationManual
    NbCmb = WorksheetFunction.Combin(a, b): NbWrt = NbCmb: ReDim Tc(1 To b)
    Do
        Sheets.Add: s = s + 1
        Do
            NbRw = Round(IIf(NbWrt > Rows.Count, Rows.Count, NbWrt)): ReDim Tb(1 To NbRw, 1 To b)
            If c = 0 And s = 1 Then
                For i = 1 To b
                    Tb(1, i) = i
                Next i
            Else
                For i = 1 To b
                    Select Case i
                        Case 1
                            Tb(1, i) = IIf(Tc(i + 1) = a - b + 2, Tc(i) + 1, Tc(i))
                        Case b
                            Tb(1, i) = IIf(Tc(i) = a, Tc(i - 1) + 1, Tc(i) + 1)
                        Case Else
                            Tb(1, i) = IIf(Tc(i + 1) = a - b + i + 1, IIf(Tc(i) = a - b + i, Tc(i - 1) + 1, Tc(i) + 1), Tc(i))
                    End Select
                Next i
            End If
            For i = 2 To NbRw
                For j = 1 To b
                    Select Case j
                        Case 1
                            Tb(i, j) = IIf(Tb(i - 1, j + 1) = a - b + 2, Tb(i - 1, j) + 1, Tb(i - 1, j))
                        Case b
                            Tb(i, j) = IIf(Tb(i - 1, j) = a, Tb(i, j - 1) + 1, Tb(i - 1, j) + 1)
                        Case Else
                            Tb(i, j) = IIf(Tb(i - 1, j + 1) = a - b + j + 1, IIf(Tb(i - 1, j) = a - b + j, Tb(i, j - 1) + 1, Tb(i - 1, j) + 1), Tb(i - 1, j))
                    End Select
            Next j, i
            Set Rg = Range(Cells(1, c * (b + 1) + 1), Cells(NbRw, c * (b + 1) + b)): Rg = Tb
            NbWrt = Round(NbWrt - NbRw): If NbWrt = 0 Then Exit Do
            For i = 1 To b
                Tc(i) = Tb(NbRw, i)
            Next i
            c = c + 1
        Loop Until c * (b + 1) + b > Columns.Count
        c = 0
    Loop Until NbWrt = 0
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True: Application.Calculation = m
End Sub
 

Discussions similaires


Haut Bas