XL 2016 Aide pour creer une macro pechue

phil77515 · 13 Janvier 2020

bonjour

je souhaiterais avoir de l'aide pour créer un petit sous excel

au premier tour
il s'agit de composer des binômes en fonction de critères Puis de leur attribuer un gage

au second tour
toujours pareil sauf que les binômes doivent changer

idem au 3eme et 4eme tour

j'ai prépare un fichier avec déjà des éléments mais mes limites sont atteintes

merci de votre aide

phil77515 · 6 Avril 2021

phil77515 à dit:
bonjour danreb

j'"e'spere que ca va avec cette situation deplorable

phil77515 à dit:
je reviens sur mon petit jeu car avec le confinement on se remets sur les appli
j'ai redui a 4 couple et la ca coince car il dit qu'il ne peut pas faire 4 tours comptetenu qu'il y a 3 participants

il faudrait donc que si le nombre de couple est < à 4 , il mette un tirage vide pour le 4 eme

bien a toi merci

phil77515 · 6 Avril 2021

mapomme à dit:
Bonjour @phil77515 , @Dranreb ,

Une dernière version qui tente:

de ne pas affecter un même gage à un participant pour l'ensemble des 4 tirages

de ne pas affecter deux fois le même gage lors d'un tour

bonjour ma pomme
j'espere que tout va
idem que pour reponse a danreb , en dessous de 4 couples il faut que le 4 eme tirage soit vide
merci

phil77515 · 6 Avril 2021

phil77515 à dit:
bonjour ma pomme
j'espere que tout va
idem que pour reponse a danreb , en dessous de 4 couples il faut que le 4 eme tirage soit vide
merci

oui mais la il tourne en rond , car effectivement si 4 tirage et 3 possinilite , le dernier tirage ne peut remplir la condition ; et donc il arrive sur infructueux

Dranreb · 6 Avril 2021

Bonjour.
Pareil pour moi. Même s'il n'y a aucune incompatibilité demandée, s'ils ne sont que 4 il ne peuvent chacun en rencontrer que 3 autres, donc pas de quoi faire un 4ème tour.
Édition: C'est plus compliqué. J'ai dû mal à replonger dedans. C'est peut être plutôt parce qu'il n'y a pas assez de rencontres multiples expressément autorisées, c'est à dire pas assez de cases dans la grille avec un nombre > 1 (une case vide est assumée = 1).

phil77515 · 6 Avril 2021

re
ce qu'il faudrait c'est pouvoir donner le nombre de tirages à realiser au debut ou avec un Nbval des hommes
si 3 couples = 2 tirages
si 4 couples = 3 ...............
si 5 > 20 couples 4 tirages

phil77515 · 6 Avril 2021

bonjour

je suis arrive a bidouille

Dranreb · 6 Avril 2021

Ça ne passe pas si vous mettez 2 partout dans la grille ?

phil77515 · 6 Avril 2021

Dranreb à dit:
Ça ne passe pas si vous mettez 2 partout dans la grille ?

je ne comprends pas
meme en corsant les incompatibilites , on arrive à 1 tirage

par contre un conseil

j'ai mis un gif anime qui est place dans un userform que j'ai appelé "Merci_de_patienter"
je voudrais le faire tourner durant l'excution de la macro quand on est 10 couples avec plein d'incompatibilite ,

soit j'ai une image figée t la macro tourne
ou alors avec d'autres codes une image qui tourne mais qui fige la macro

ci joint fichier avec 1 grille et 2 partpout

Dranreb · 6 Avril 2021

La grille permet de signaler des incompatibilité par une lettre, mais elle permet aussi, au contraire, d'autoriser plusieurs fois la rencontre de deux personnes
Dans mon fichier d'origine Il y avait déjà un UFmVisu qui montrait bien plus précisément l'activité du tirage en cours, non ?
Mais je vois que ce n'est pas ma solution que vous avez finalement choisi de suivre.

phil77515 · 6 Avril 2021

voila voter dernier fichier

Dranreb · 8 Avril 2021

Bonsoir.
Je n'avais pas vu votre dernier poste.
Mais j'ai fait l'essai: en mettant partout 2 dans la grille sauf sur la diagonale, mon classeur trouve bien une solution pour 4 tours avec 3 couples. (Il n'y a plus le message car chaque participant a 2 × 2 soit 4 rencontres possibles)

Dranreb · 8 Avril 2021

Je joins quand même une version sans message d'erreur, qui ajuste le nombre de manches au nombre de rencontres possibles du participant qui en permet le moins, sans toutefois dépasser 4.

phil77515 · 9 Avril 2021

merci c'est super , j'aiteste , c'est ultra rapide

j'etudie vos codes , merci

Dranreb · 10 Avril 2021

Bonjour.
Je pense avoir trouvé une anomalie dans ma Function Trouvé. Il me semble qu'on n'en sort pas assez tôt quand il fixe la dernière paire. Étonnant que ça ne l'empêche pas de finir. Je l'ai corrigée comme suit :

VB:

Private Function Trouvé(ByVal Niv As Long) As Boolean
   Dim M As Long, LAtJ As ListeAléat, PJ As Long, J As Long, _
       L As Long, LAtG As ListeAléat, PG As Long, G As Long
   UFmVisu.Montre Niv / NivMax
   M = Niv \ NbEQu + 1: L = Niv Mod NbEQu + 1: Set LAtJ = TLAtJ(M): Set LAtG = TLAtG(M)
   If L = 1 And M > 1 And NbGages >= 2 * NbEQu Then
      LAtG.Init NbGages: For L = 1 To NbEQu: LAtG.Supprimer TTir(M - 1, L, 2): Next L
      L = Niv Mod NbEQu + 1: End If
   Do: If UFmVisu.Abandon Then Exit Function
      PJ = PJ + 1: J = LAtJ.Aléat(PJ): If J = 0 Then Exit Function
      If TNbRenc(L, J) Then
         PG = 0: Do: PG = PG + 1: G = LAtG.Aléat(PG): If G = 0 Then Exit Function
            Loop While TGAttr(1, L, G) Or TGAttr(2, J, G)
         LAtJ.Supprimer J: TNbRenc(L, J) = TNbRenc(L, J) - 1: LAtG.Supprimer G: TGAttr(1, L, G) = True: TGAttr(2, J, G) = True
         TTir(M, L, 1) = J: TTir(M, L, 2) = G
         If Niv >= NivMax Then Trouvé = True: Exit Function
         Trouvé = Trouvé(Niv + 1): If Trouvé Then Exit Function
         LAtJ.Remettre J, PJ: TNbRenc(L, J) = TNbRenc(L, J) + 1: LAtG.Remettre G, PG: TGAttr(1, L, G) = False: TGAttr(2, J, G) = False
         End If
      Loop
   End Function

i

phil77515 · 12 Avril 2021

bonjour danreb

merci , j'ai mis a jour

par contre je ne trouve pas de fonction timer pour UFmVisu , j'ai vu durééenclair mais ca doit etre le calcul
car je voudrais reduire sa duree de vision apres le resulat

sinon est ce la dedans

Private Sub Visu(ByVal S As Double)
LabFait.Width = SMin * LabTout.Width
LabPbl1.Left = LabFait.Left + LabFait.Width: LabPbl1.Width = (S - SMin) * LabTout.Width
LabPbl2.Left = LabPbl1.Left + LabPbl1.Width: LabPbl2.Width = (SMax - S) * LabTout.Width
End Sub

merci

XL 2016 Aide pour creer une macro pechue

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires