XL 2016 correction pour perfectionnement

J

jacquot16

XLDnaute Nouveau

• 16 Avril 2020

• #2

juste oublié "jacques" pour le MDP et l’accès au code en cliquant sur la croix

 

Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 16 Avril 2020

• #3

Bonjour Jacquot, et bienvenu sur XLD.
Hors VBA je trouve qu'il y a un joli bug du fait d'utiliser alea() pour la formation des groupes.
Si vous faites Recalculer l'ensemble des groupes est recalculé. Donc impossible de faire quoi que ce soit pour les résultats. Les groupes sont dynamiques.
Vous pourriez lancer cette macro au départ des inscriptions :

VB:

Sub TirageAuSort()
Application.ScreenUpdating = False
For i = 2 To 99
    Sheets("inscription").Range("B" & i) = 100 * Rnd + i / 1000
Next i
End Sub

De cette façon une fois le tirage au sort effectué, on ne touche plus à la formation des groupes, et on peut exploiter les Parties et résultats.

 

Vote positif 0 Vote négatif

J

jacquot16

XLDnaute Nouveau

• 16 Avril 2020

• #4

bonjour Sylvanu
merci de intéresser à mon petit projet
j'avais réglé ce problème en effaçant les formules des cellules concernées dans l' USF2 .
mais je vais tester ton code et je reviendrai vers toi

 

Vote positif 0 Vote négatif

J

jacquot16

XLDnaute Nouveau

• 16 Avril 2020

• #5

alors oui , formule définitivement adoptée .
du code Excel en moins pour le même résutat
merci Sylvanu

 

Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 16 Avril 2020

• #6

Au post #1 vous dites :

je me suis lancé le challenge de faire une programmation en VBA (

Cliquez pour agrandir...

et que vois je en feuille Inscription : Plein de formules !
Alors un petit bout de code :

VB:

Sub TirageAuSort()
Application.ScreenUpdating = False
[D5:F100].ClearContents
For i = 2 To 99
    Sheets("inscription").Range("B" & i) = 100 * Rnd + i / 1000
Next i
DerLig = Application.WorksheetFunction.CountA(Range("A1:A10000"))
If WorksheetFunction.Even(DerLig) = DerLig Then
    DerLig = DerLig - 1
    MsgBox "Attention, nombre d'équipes impaire"
End If
Equipe = 1: PetiteValeur = 0
For i = 2 To DerLig Step 2
    PetiteValeur = PetiteValeur + 1
    Indice = Application.Small(Range("B2:B" & DerLig), PetiteValeur)
    NomEquipe = Application.Match(Indice, Range("B2:B" & DerLig), 0)
    [D5:D54].Cells(Equipe, 1) = [A2:A100].Cells(NomEquipe, 1)
    PetiteValeur = PetiteValeur + 1
    Indice = Application.Small(Range("B2:B" & DerLig), PetiteValeur)
    NomEquipe = Application.Match(Indice, Range("B2:B" & DerLig), 0)
    [F5:F54].Cells(Equipe, 1) = [A2:A100].Cells(NomEquipe, 1)
    Equipe = Equipe + 1
Next i
[B2:B100].ClearContents
[A1].Select
End Sub

On construit les équipes de façon aléatoire et automatique ... et sans formules dans la feuille.

 

Vote positif 0 Vote négatif

J

jacquot16

XLDnaute Nouveau

• 16 Avril 2020

• #7

hahah
bon alors j'ai besoin d'un petit peu de temps pour comprendre tout ça
j’essaie de comprendre tout seul et je reviens ici
merci encore c'est drôlement sympa à toi de perdre du temps avec moi

 

Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 16 Avril 2020

• #8

D'une part le forum est fait pour ça, d'autre part en ce moment on a du temps.

 

Vote positif 0 Vote négatif

J

jacquot16

XLDnaute Nouveau

• 16 Avril 2020

• #9

impossible d'ajouter le code pour l'essayer
erreur systématique
je ne trouve pas quoi
si je reviens à l'ancien programme ça fonctionne , mais je reconnais que j'ai déjà reçue cette erreur sans la comprendre
revenir à une copie faisait marcher le programme ????
peux tu jeter un œil
j'ai surement mal écrit cette routine

 

Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 16 Avril 2020

• #10

Un petit fichier serait le bienvenu.
Le code s'analyse mal sur un jpeg.

 

Vote positif 0 Vote négatif

J

jacquot16

XLDnaute Nouveau

• 17 Avril 2020

• #11

bonjour Sylvanu

c'est le même programme que celui que j'ai mis en lien au début du fil
tu trouveras le code dans l'Userform2
mais je vais voir si je ne peux pas me débarrasse du problème en faisant différemment
celui-ci me sert à indiquer la ligne d'entrée des équipes et c'est sans doute possible de le faire autrement

à bientôt

 

Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 17 Avril 2020

• #12

Bonjour Jacquot,
Généralement quand une fois ça marche, une fois ça marche pas, c'est qu'une variable n'est pas ou est mal initialisée. Donc suivant le contexte, la page active ça marche ou ça marche pas.
Je pense qu'il faudrait préciser la page concernée sur cette ligne, avec un Sheets(xxxx) :

VB:

Set PlageDeRecherche = Range(Cells(2, 1), Cells([b2] + 1, 1))

Ensuite lorsque le bug apparaît promener votre souris (sans cliquer ) sur "trouver" un popup vous donnera sa valeur, à mon avis il est vide, d'où trouver.Row n'a pas de signification.
Je ne peux guère aller plus loin car étant sous XL2007 les 3 Private Declare PtrSafe sont en erreur, il faut que je regarde comment faire.

 

Vote positif 0 Vote négatif

J

jacquot16

XLDnaute Nouveau

• 22 Avril 2020

• #13

bonjour amis confinés
alors voilà ,j 'ai donc tout repris depuis le début et supprimé tous les codes non faits en VBA .
j'y ai mis un peu de temps mais ça fonctionne correctement
merci à Sylvanu pour le module de tirage au sort que j'ai adopté tel quel car il convient bien à ce que je voulais faire. ( et je pense l'avoir compris même si le code était nouveau pour moi)
donc vous pouvez apporter vos remarques de codeurs confirmés et autres éclaircissements sur ce fil qui , je l’espère , contribuera à enrichir mes connaissances et peut-être à d'autres qui sont appentis sur ce forum.
vous pouvez utiliser et distribuer ce petit programme autant que vous voulez , et j’espère qu'il sera utile à toutes les associations boulistiques susceptibles d'organiser des rencontres sauvages en 4 parties .
Jacquot

 

Pièces jointes

• Base 4 parties portable.xlsm

  144.2 KB · Affichages: 10

Vote positif 0 Vote négatif