extraire donnees sous conditions

[jeanmimi62]

bonjour,
dans le tableau joint pour exemple la colonne A représente des noms de clubs (de foot), la colonne B les divisions où ces équipes évoluent et les colonnes C à H les distances entre les clubs
je cherche à faire un tirage au sort entre les clubs sous condition (pas de rencontre de même division et pas plus de 50 km et ceci en effectuant un simple click sur le bouton. Je réussi à faire toutes ces opérations une à une mais pas ensemble
merci pour votre aide précieuse

 

[job75]

Re : extraire donnees sous conditions

Bonjour jeanmimi62,

Dans cette solution on détermine tous les arrangements valides de 2 équipes, puis on y réalise un tri aléatoire :

Sub Tirages()
Dim n%, lig%, i%, j%, plage As Range
Application.ScreenUpdating = False
n = Application.CountA(Rows(1)) 'nombre d'équipes
lig = n + 4 '1ère ligne d'écriture
Range("A" & lig & ":C65536").ClearContents
'---Détermination de tous les arrangements valides---
For i = 2 To n + 1
  For j = 2 To n + 1
    If Cells(i, 2) <> Cells(j, 2) And Cells(i, j + 1) <= 50 Then
      Cells(lig, 1) = Cells(i, 1)
      Cells(lig, 2) = Cells(j, 1)
      lig = lig + 1
    End If
  Next
Next
'---Tri aléatoire---
Set plage = Range(Cells(n + 4, 3), Cells(lig - 1, 3))
plage.Formula = "=RAND()"
plage.Offset(, -2).Resize(, 3).Sort Key1:=plage, Order1:=xlAscending, Header:=xlNo
plage.ClearContents
End Sub

Edit : dans les arrangements l'ordre de 2 équipes importe, et c'est utile par exemple pour avoir l'endroit où se joue le match. Si l'on veut les combinaisons, il faut modifier les boucles For...Next en écrivant :

For i = 2 To n
  For j = i + 1 To n + 1

A+

 

[job75]

Re : extraire donnees sous conditions

Re, salut masterdisco 🙂

Je fais un Edit sur mon post précédent, il y avait une imprécision sur les boucles.

A+

 

[jeanmimi62]

Re : extraire donnees sous conditions

Bonjour, et merci pour

 

[jeanmimi62]

Re : extraire donnees sous conditions

bonjour et merci pour ton aide

 

[jeanmimi62]

Re : extraire donnees sous conditions

bonjour et merci pour votre aide
dans mon mon fichier original il y aura environ 130 équipes, celle-ci se rencontreront suivant les critères expliqués dans l'exemple, il faut donc que lorsque qu'une équipe est tirée au sort, elle n'apparaisse plus dans le reste du tirage
mais j'avoue que la solution fonctionne nickel

 

[job75]

Re : extraire donnees sous conditions

Re,

dans mon mon fichier original il y aura environ 130 équipes

Cela fera donc environ 130 x 129 = 16770 arrangements à étudier. Par contre si l'on étudie seulement les combinaisons (voir l'Edit de mon 1er post), ce nombre sera divisé par 2.

il faut donc que lorsque qu'une équipe est tirée au sort, elle n'apparaisse plus dans le reste du tirage

Cela retire beaucoup d'arrangements ou de combinaisons...

La macro modifiée (en rouge) :

Sub Tirages()
Dim n%, lig%, i%, j%, plage As Range, sup As Range
Application.ScreenUpdating = False
n = Application.CountA(Rows(1)) 'nombre d'équipes
lig = n + 4 '1ère ligne d'écriture
Range("A" & lig & ":C65536").ClearContents
'---Détermination de tous les arrangements valides---
For i = 2 To n + 1
  For j = 2 To n + 1
    If Cells(i, 2) <> Cells(j, 2) And Cells(i, j + 1) <= 50 Then
      Cells(lig, 1) = Cells(i, 1)
      Cells(lig, 2) = Cells(j, 1)
      lig = lig + 1
    End If
  Next
Next
'---Tri aléatoire---
Set plage = Range(Cells(n + 4, 3), Cells(lig - 1, 3))
plage.Formula = "=RAND()"
plage.Offset(, -2).Resize(, 3).Sort Key1:=plage, Order1:=xlAscending, Header:=xlNo
plage.ClearContents
[COLOR="Red"]'---Si une équipe est déjà inscrite, suppression de la ligne
For i = n + 5 To lig - 1
Set plage = Range(Cells(n + 4, 1), Cells(i - 1, 2))
If Application.CountIf(plage, Cells(i, 1)) Or Application.CountIf(plage, Cells(i, 2)) Then _
 Set sup = Union(Rows(i), IIf(sup Is Nothing, Rows(i), sup))
Next
sup.Delete[/COLOR]
End Sub

Edit : on remarquera que les tirages donnent des nombres de rencontres différents. C'est normal.

A+

 

[jeanmimi62]

Re : extraire donnees sous conditions

Bonjour,
votre première soluce me donne tous les matchs possibles d'aprés les conditions
c'est bien, mais il faut que chaque équipe soit tirée au sort. en gros je dois faire le tirage au sort d'une coupe regroupant 130 équipes pour qu'ensuite il reste 65 équipes puis 33 etc jusque la finale
c'est pourquoi il faur que toutes les équipes ait un match
merci pour votre aide ça avance plus vite avec vous car cela fait deux mois que je suis sur ce pb

 

[job75]

Re : extraire donnees sous conditions

Bonjour jeanmimi62, le forum,

La version précédente était erronée 😡 je supprimais trop de lignes.

Il fallait d'abord effacer les lignes indésirables.

Par ailleurs j'ai ajouté un message en fin de macro.

Il faut faire plusieurs tirages successifs, et stocker ces tirages dans la feuille "Stockage" quand on tombe sur un nombre d'équipes plus grand.

On peut automatiser ce système, mais il faut d'abord voir comment cela se comporte sur un grand nombre d'équipes : trouve-t-on toujours toutes les équipes, et rapidement ???

Les macros :

Sub Tirages()
Dim n%, lig%, i%, j%, plage As Range, sup As Range, n1%
Application.ScreenUpdating = False
n = Application.CountA(Rows(1)) 'nombre d'équipes
lig = n + 4 '1ère ligne d'écriture
Range("A" & lig & ":C65536").ClearContents
'---Détermination de tous les arrangements valides---
For i = 2 To n + 1
  For j = 2 To n + 1
    If Cells(i, 2) <> Cells(j, 2) And Cells(i, j + 1) <= 50 Then
      Cells(lig, 1) = Cells(i, 1)
      Cells(lig, 2) = Cells(j, 1)
      lig = lig + 1
    End If
  Next
Next
'---Tri aléatoire---
Set plage = Range(Cells(n + 4, 3), Cells(lig - 1, 3))
plage.Formula = "=RAND()"
plage.Offset(, -2).Resize(, 3).Sort Key1:=plage, Order1:=xlAscending, Header:=xlNo
plage.ClearContents
'---Si une équipe est déjà inscrite, suppression de la ligne---
For i = n + 5 To lig - 1
  Set plage = Range(Cells(n + 4, 1), Cells(i - 1, 2))
  If Application.CountIf(plage, Cells(i, 1)) Or Application.CountIf(plage, Cells(i, 2)) Then
    [COLOR="Red"]Rows(i).Resize(, 2) = ""[/COLOR]
    Set sup = Union(Rows(i), IIf(sup Is Nothing, Rows(i), sup))
  End If
Next
sup.Delete
Application.ScreenUpdating = True
n1 = Application.CountA(Range(Cells(n + 4, 1), "B65536"))
MsgBox "Nombre d'équipes : " & n1 & IIf(n1 = n, Chr(10) & "Toutes les équipes sont tirées.", "")
End Sub

Sub Stockage()
Dim n%
n = Application.CountA(Rows(1)) 'nombre d'équipes
Sheets("Stockage").Range("A:B").Clear
Range(Cells(n + 3, 1), "B65536").Copy Sheets("Stockage").Range("A1")
End Sub

A+

 

[job75]

Re : extraire donnees sous conditions

Re,

J'avance un peu plus.

On peut se passer de la feuille "Stockage" et procéder ainsi :

- On se fixe un nombre maximum de tirages (20, 50, 100 ?) qu'on réalise jusqu'à ce que toutes les équipes soient tirées.

- Si l'on ne parvient pas à tirer toutes les équipes, on augmente la distance limite (50 km puis 100 puis 150) dans la macro :

If Cells(i, 2) <> Cells(j, 2) And Cells(i, j + 1) <= [B][SIZE="3"]50[/SIZE][/B] Then

On peut paramétrer cette distance limite et automatiser le processus. Mais on n'obtiendra pas forcément la solution car il y a aussi la contrainte "pas de rencontre de même division".

Un détail : le nombre d'équipes doit toujours être pair bien sûr. Dans les poules, si ce n'est pas le cas, il faut prévoir un repéchage pour obtenir ce nombre.

A+

 

[jeanmimi62]

Re : extraire donnees sous conditions

bonjour et encore merci de votre aide
j'ai fait des essais avec 30 équipes et à voir la dernière équipe du tableau n'est jamais tiré au sort. Si je rajoute une ligne bidon j'ai bien mes 30 équipes

 

[job75]

Re : extraire donnees sous conditions

Re,

(...) à voir la dernière équipe du tableau n'est jamais tiré au sort. Si je rajoute une ligne bidon j'ai bien mes 30 équipes

Je ne comprends pas. Une ligne bidon ???

Merci de joindre le fichier (zippé).

A+

 

[jeanmimi62]

Re : extraire donnees sous conditions

Re,



Je ne comprends pas. Une ligne bidon ???

Merci de joindre le fichier (zippé).

A+

bonsoir,
pour être exact pour avoir mes 30 équipes, je dois ajouter une colonne à la fin que je nomme AA ou autre chose et alors j'ai bien un tirage avec mes 30 équipes
exemple ici :