XL 2016 correction pour perfectionnement

jacquot16

XLDnaute Nouveau
bonjour à tous
je me lance
depuis environ 1 mois je me suis lancé le challenge de faire une programmation en VBA ( je précise qu'à la base je n'y connaissais absolument rien)
j'ai donc décider , étant joueur de pétanque , de faire un programme qui gérerait une rencontre sauvage en 4 parties et bout de code après bout de code, j'ai réussi à le mettre au point ( du moins suffisamment pour que ça fonctionne correctement et comme je le souhaitai )
Reste que maintenant je me dis que le code devrait surement pouvoir s'améliorer puis ce que je suis un gros débutant.
j'en appel donc à vos lumières et à vos critiques .
quelles sont les améliorations que je dois envisager?
quels sont les bouts de codes qui sont à vos yeux incorrectes ou que vous auriez écris différemment ?
toutes vos remarques seront les bienvenues .

d'avance merci
 

Pièces jointes

  • Base 4 parties portable.xlsm
    124.9 KB · Affichages: 15

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Au post #1 vous dites :
je me suis lancé le challenge de faire une programmation en VBA (
et que vois je en feuille Inscription : Plein de formules ! :mad:
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. :)
 

jacquot16

XLDnaute Nouveau
Capture.JPGCapture2.JPG
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
 

jacquot16

XLDnaute Nouveau
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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

jacquot16

XLDnaute Nouveau
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

Discussions similaires

Statistiques des forums

Discussions
312 361
Messages
2 087 627
Membres
103 608
dernier inscrit
rawane