VBA: modification 2 paramètres.

[JJ1]

Bonjour,

J'ai une macro dans un fichier Excel (il me semble réalisée par Job75).

Cette macro prend 20 nombres de A2 à T2 et restitue des combinaisons de 3 nombres (parmi 20) colonnes AW:AY avec le nombre col BB et l'écart col BC dans la plage.

dont je voudrais modifier 2 paramètres:

- uniquement 13 nombres (au lieu de 20) donc U2:M2
- combinaisons de 4 nombres au lieu de 3 (donc Col AW:AZ au lieu de AY)
Le reste inchangé.

Voici le code:

Sub calcul()
Dim tps As Double, tablo(19), i As Byte, j As Byte, k As Byte
Dim t1(65532), t2(65532), t3(65532)
Dim x As Integer, r As Range, c As Byte, nb(65532), ligne(65532)
Range("AW2:BC10000").ClearContents
tps = Now
Application.ScreenUpdating = False

For i = 0 To 19
tablo(i) = Cells(2, i + 1)
Next

For i = 0 To 17
For j = i + 1 To 18
For k = j + 1 To 19
t1(x) = tablo(i)
t2(x) = tablo(j)
t3(x) = tablo(k)
c = 0
For Each r In [plage].Rows 'recherche la combinaison dans [plage]
If IsError(Application.Match(t1(x), r, 0)) Then GoTo 1
If IsError(Application.Match(t2(x), r, 0)) Then GoTo 1
If IsError(Application.Match(t3(x), r, 0)) Then GoTo 1
c = c + 1
If c = 1 Then ligne(x) = r.Row '1ère ligne trouvée
1 Next
nb(x) = c 'comptage
x = x + 1
Next
Next
Next

Range("AW2:AW" & x + 3).Value = Application.Transpose(t1)
Range("AX2:AX" & x + 3).Value = Application.Transpose(t2)
Range("AY2:AY" & x + 3).Value = Application.Transpose(t3)
Range("BB2:BB" & x + 3).Value = Application.Transpose(nb)
Range("BC2:BC" & x + 3).Value = Application.Transpose(ligne)

Range("A4:J65536").Sort Key1:=Range("H4"), Order1:=xlDescending, _
Key2:=Range("J4"), Order2:=xlAscending, Header:=xlNo

Application.ScreenUpdating = True
MsgBox Chr(10) & "Nombre de combinaisons : " & x & Chr(10) & Chr(10) & _
"Combinaisons dans la plage : " & Application.Sum(Range("H4:H65536")) & " " & Chr(10) & Chr(10) & _
"Durée du calcul : " & Format(Now - tps, "h ""mn"" s ""s""") & Chr(10)
End Sub

Merci d'avance
Bon dimanche

 

[job75]

Re : VBA: modification 2 paramètres.

Bonjour JJ1,

En effet il s'agit d'une de mes soutions sur ce fil :

https://www.excel-downloads.com/threads/macro-de-combinaisons.117158/

Je ne l'ai plus trop en tête, mais je vais voir comment adapter cette macro.

A noter que cette solution n'était pas la meilleure en terme de rapidité, ROGER2327 y avait fait de fort belles choses

A+

 

[job75]

Re : VBA: modification 2 paramètres.

Re,

J'ai adapté la macro un peu à l'aveugle, n'ayant pas ton fichier où elle devra se trouver.

Si pas ça, joins le fichier.

Sub calcul()
Dim tps As Double, tablo(12), i As Byte, j As Byte, k As Byte, l As Byte
Dim t1(65532), t2(65532), t3(65532), t4(65532)
Dim x As Integer, r As Range, c As Byte, nb(65532), ligne(65532)
Range("[COLOR="Red"]AW2[/COLOR]:BC65536").ClearContents
tps = Now
Application.ScreenUpdating = False

For i = 0 To 12
tablo(i) = Cells(2, i + 1)
Next

For i = 0 To 9
For j = i + 1 To 10
For k = j + 1 To 11
For l = k + 1 To 12
t1(x) = tablo(i)
t2(x) = tablo(j)
t3(x) = tablo(k)
t4(x) = tablo(l)
c = 0
For Each r In [plage].Rows 'recherche la combinaison dans [plage]
If IsError(Application.Match(t1(x), r, 0)) Then GoTo 1
If IsError(Application.Match(t2(x), r, 0)) Then GoTo 1
If IsError(Application.Match(t3(x), r, 0)) Then GoTo 1
If IsError(Application.Match(t4(x), r, 0)) Then GoTo 1
c = c + 1
If c = 1 Then ligne(x) = r.Row '1ère ligne trouvée
1 Next
nb(x) = c 'comptage
x = x + 1
Next
Next
Next
Next

Range("AW2:AW" & x + [COLOR="Red"]1[/COLOR]).Value = Application.Transpose(t1)
Range("AX2:AX" & x + [COLOR="red"]1[/COLOR]).Value = Application.Transpose(t2)
Range("AY2:AY" & x + [COLOR="red"]1[/COLOR]).Value = Application.Transpose(t3)
Range("AZ2:AZ" & x + [COLOR="red"]1[/COLOR]).Value = Application.Transpose(t4)
Range("BB2:BB" & x + [COLOR="red"]1[/COLOR]).Value = Application.Transpose(nb)
Range("BC2:BC" & x + [COLOR="red"]1[/COLOR]).Value = Application.Transpose(ligne)

Range("AW2:BC65536").Sort Key1:=Range("BB2"), Order1:=xlDescending, _
Key2:=Range("BC2"), Order2:=xlAscending, Header:=xlNo

Application.ScreenUpdating = True
MsgBox Chr(10) & "Nombre de combinaisons : " & x & Chr(10) & Chr(10) & _
"Combinaisons dans la plage : " & Application.Sum(Range("BB2:BB65536")) & " " & Chr(10) & Chr(10) & _
"Durée du calcul : " & Format(Now - tps, "[COLOR="Red"][B]m[/B][/COLOR] ""mn"" s ""s""") & Chr(10)
End Sub

Edit : j'avais décalé les colonnes BB et BC, mais ce n'est probablement pas la peine

A+

 

[JJ1]

Re : VBA: modification 2 paramètres.

Bonjour Job75 et merci, le code fonctionne parfaitement (715 combinaisons)
merci (c'était pas simple sans fichier) et bon dimanche

 

[job75]

Re : VBA: modification 2 paramètres.

Re,

Il y avait une petite erreur pour le calcul du temps à la fin : mettre "m " au lieu de "h "...

A+