Macro de combinaisons

Re : Macro de combinaisons

Re,
Eh bien! Bravo et merci Roger, c'est un sacré travail que tu as fait !
A conserver dans nos tablettes et sur XLD !

Encore merci.
Bon AM

Re : Macro de combinaisons

Re...ROGER2327

Re : Macro de combinaisons

Bonjour
je cherche presque meme chose,sauf que je veux toutes les combinaisons possible de 6 chifre de 1 à 49 sans double.
Merci les amis

Re : Macro de combinaisons

Bonjour

yanic2020

Saisis cette formule dans Excel
=COMBIN(49;6)

et tu comprendras que tu risques d'étouffer ton Excel 😉

PS: tu pouvais rester dans ton premier fil parlant de combinaisons
https://www.excel-downloads.com/threads/combinaisons.120728/


Et tu peux trouver sur le forum dasn les archives, trouver des fils relatifs au Loto
dont un qui a été très consulté.
https://www.excel-downloads.com/threads/etude-du-loto-celle-de-leuromillion.94942/

Re : Macro de combinaisons

Bonjour

Je voudrais transformer la macro ci dessous pour qu'elle calcule en 7 avec la même

procédure.
Dans le fichier zip, il y a le calcul en 7 mais la procédure a changé pour cause de

temps de calcul.
J'ai essayé de modifier mais trop de variables.


Si possible m'expliquer en gros les lignes par bloc

merci


Combi4_11_v5.zip de Jean Pierre

Sub calcul4()
'ROGER2327 fecit. 8 Germinal CCXVII.
'Révision : 11 Germinal CCXVII.
Dim oDat(), oCpt(), oSrt(1 To 4845, 1 To 6), cCmb As Range, oCel As Range
Dim y As Long, z As Long, g As Long, h As Long, i As Long, j As Long, k As Long, l

As Long, n As Long
Dim t As Single '*** Supprimer les lignes marquées *** pour supprimer le

chronomètre.
t = Timer '***
With ActiveSheet
Application.Calculation = xlCalculationManual
.Range("W3:AB4847").ClearContents
Application.ScreenUpdating = False
oDat = .Range("B2:U2").Value
Set cCmb = .Range("B4:U19")
ReDim oCpt(1 To 16, 1 To 1)
For j = 1 To 16
y = 1
For Each oCel In cCmb.Rows(j).Cells
For i = 1 To 20
If oCel = oDat(1, i) Then
y = y + 1
If y > UBound(oCpt, 2) Then ReDim Preserve oCpt(1 To 16, 1

To y)
oCpt(j, y) = oCel
Exit For
End If
Next i
Next oCel
oCpt(j, 1) = y
Next j
For h = 1 To 17
For i = h + 1 To 18
For j = i + 1 To 19
For k = j + 1 To 20
z = z + 1
oSrt(z, 1) = oDat(1, h)
oSrt(z, 2) = oDat(1, i)
oSrt(z, 3) = oDat(1, j)
oSrt(z, 4) = oDat(1, k)
oSrt(z, 5) = 0
For y = 1 To 16
g = oCpt(y, 1)
For n = 2 To g
If oDat(1, h) = oCpt(y, n) Then Exit For
Next n
If n < g Then
For n = n To g
If oDat(1, i) = oCpt(y, n) Then Exit For
Next n
If n < g Then
For n = n To g
If oDat(1, j) = oCpt(y, n) Then Exit For
Next n
If n < g Then
For n = n To g
If oDat(1, k) = oCpt(y, n) Then Exit

For
Next n
If n <= oCpt(y, 1) Then
oSrt(z, 5) = oSrt(z, 5) + 1
oSrt(z, 6) = oSrt(z, 6) & "#" & y
End If
End If
End If
End If
Next y
Next k
Next j
Next i
Next h
.Range("W3:AB4847").Value = oSrt
.Range("W3:AB4847").Sort Key1:=Range("AA3"), Order1:=xlDescending,

Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox Round(Timer - t, 1) & " s" '***
End Sub