Mélangeur deux par deux

Webperegrino

XLDnaute Impliqué
Supporter XLD
Bonjour,
Je désire l'aide d'un expert en VB ou macro qui pourrait alimenter en formules le fichier ci-joint que je n'arrive pas achever.
J'ai bien essayé avec une macro proposée à BERNARD sur le forum pour son rangement de joueurs par POULES, mais je n'arrive pas à l'appliquer ici.
En effet j'ai quatre tableaux avec des critères à prendre en compte avant de place le résultat souhaité dans une feuille ... "Résultats"
Je joins aussi une synthèse de la présentation du travail préparé t ce que je souhaite.
Merci d'avance pour cette aide

Synthèse :
Explications du fonctionnement du mélangeur souhaité

L’objectif est de ranger une liste de personnes (2 à 40) par couple en fonction de quatre tableaux de critères.

Le fichier contient :
- La liste (A) des personnes recevant 2 à 40 personnes.
- Les calculs tiendront compte des désirs des personnes :
- Liste de critère 1 : ALLER DE PRÉFÉRENCE AVEC'.
- Liste de critère 2 : NE PAS ÊTRE AVEC
- Deux listes SP (spectacles) :
- Liste de critère 3 : les Indisponibilités des personnes pour les après-midi.
- 40 SP 'Après-midi' au maximum à saisir (ici 8 SP de saisis)
- Les calculs se feront en fonction du nombre de SP placés entête de colonnes du tableau.
- Liste critère 4 : les Indisponibilités pour les soirs
- une liste RÉSULTAT pour les résultats des calculs, les personnes sont rangées deux par deux.


Objectifs :
Les calculs pourraient être lancés par exemple grâce au bouton bleu « Mélanger » sur la feuille « Résultats ».
Les calculs présenteront, dans les cellules jaunes de cette feuille, un assemblage de personnes rangées deux par deux en fonction des critères 1, 2, 3 et 4.
Les calculs ne prennent pas en compte le reste de(s) tableau(x) sous les entêtes de colonnes non complétées
À chaque appui sur un bouton, les calculs pourraient présenter un autre assemblage par deux

Conditions de fonctionnement et de saisies :
Listes critère 1 et de critère 2 :
- les entêtes horizontaux et verticaux se remplissent en fonction des personnes entrées dans la liste (A) de départ
- un X est placé à l'intersection de ceux qui aimeraient être ensemble (critère 1) si possible, et ne pas être ensemble (critère 2).
- la liste critère 1 entrera en action dans la mesure où la « préférence » peut être placée dans les calculs à venir.

Listes critère 3 et de critère 4 : les indisponibilités des « SP de l’après-midi » et des « SP du soir »
- on saisit les entêtes horizontaux (jusqu’à 40 maximum)
- pour les indisponibilités, un X est placé à l'intersection des personnes paraissant en colonne 1
- la colonne 1 fait paraître les noms saisis dans la liste (A)
- les SP sont saisis en première ligne ; dans le cas présent :
- jusqu’à SP 8 pour la Liste « Après-midi », mais le calcul devra pouvoir être fait jusqu’à SP 40 si ce dernier est aussi saisi,
- jusqu’à SP 54 pour la Liste « Soirée », mais le calcul devra pouvoir être fait jusqu’à SP 80 si ce dernier est aussi saisi,

Une « cerise sur le gâteau » :
L'idéal serait que les personnes saisies se retrouvent avec à peu près le même nombre de positionnements au total en fonction du nombre de SP1 à SP80 maxi saisis.


Bernard, sur le forum, a bien créé une macro pour ranger des personnes mais je n’arrive pas à faire l’adaptation ici, en dehors de les ranger par deux et non par quatre :
Option Explicit
Option Base 1
Sub PoulesQuatre()
' Macro enregistrée le 09/04/09 par Bernard
Dim TabJ As Variant
Dim Z As Byte, i As Byte, j As Integer, k As Integer, l As Integer, T As Byte, X As Byte
Dim Nbinscrits As Byte, NbPoules As Byte, NbRestants As Byte, joueur As String, P As Byte, B As Byte, C As Byte

Application.ScreenUpdating = False
With Sheets("Poules")
' Dernière ligne
Z = .Range("A65536").End(xlUp).Row
' Nombre de joueurs inscrits
Nbinscrits = Z - 1
' Nombre de poules
NbPoules = Int(Nbinscrits / 4)
'Effacements des plages
Union(.Range("B2:B" & Z), .Range("D1:W6")).ClearContents
' Mise en mémoire du tableau des joueurs
TabJ = .Range("A2:A" & Z)
' Déclaration et définition du tableau de la liste aléatoire
ReDim Tablo(1 To UBound(TabJ), 1 To 2)
Randomize 'Initialisation du générateur de nombres aléatoires
' Tirage aléatoire des joueurs et mise en tableau de la liste aléatoire
For j = 1 To Z - 1
Do
X = 0
T = Int((Z - 1) * Rnd) + 1
Tablo(j, 1) = TabJ(T, 1) ' Mise en colonne aléatoire
For k = 1 To j - 1
If Tablo(k, 1) = Tablo(j, 1) Then
X = 1
Exit For
End If
Next k
Loop Until X = 0
Next j
'Mise en place des poules
For P = 1 To NbPoules
Cells(1, P + 2) = "POULE " & P
'Affichage des joueurs dans les poules
For j = 1 To 2
B = B + 1
Cells(j + 1, P + 2) = Tablo(B, 1)
Next j
Next P
End With
End Sub
 

Pièces jointes

  • Mélangeur.zip
    14.3 KB · Affichages: 37

Webperegrino

XLDnaute Impliqué
Supporter XLD
Re : Mélangeur deux par deux

Bonjour,
Je me permets de relancer ma demande du 1er mai.
Mes différents essais effectués en cours de la semaine n'aboutissent à rien.
J'ai vraiment besoin de plus fort que moi : cela devrait être plus facile à trouver...
Merci a courageux pour la réponse : travail possible ou pas sous Excel 2003
 

Discussions similaires