XL 2019 VBA newbie

apocalypse · 14 Juillet 2025

Bonjour,

J'essaie de mettre en place une gestion d'équipe pour le club auquel j'appartiens à travers un fichier excel.
N'étant pas un grand utilisateur d'Excel je découvre peu à peu ses fonctionnalités donc j'espère que vous serez indulgent avec moi 😉.

Je vous explique rapidement ce que j'ai fait et souhaite faire:
- la feuille Liste des joueurs contient les joueurs du club que je peux ajouter dans des équipes
- la feuille Gestion permet d'ajouter les joueurs dans des équipes, à travers cette feuille je veux aussi montrer à l'utilisateur si il peut ou non ajouter certains joueurs dans certaines équipes
- la feuille Param permet de mettre en place des paramètres (nombre de joueur par équipes, nombre de joueurs qui sont en dehors de l'UE par équipes...)
- la feuille Règles permet de mettre en place certaines règles qui permettent ou non d'ajouter des joueurs dans l'équipe

Actuellement dans la feuille Gestion j'ai "réussi" à mettre en place la règle "nombre de joueur par équipes" à travers des cellules qui passent au vert quand le nombre de joueurs dans l'équipe est correct.
Je dis réussi car comme vous pouvez le voir dans un autre post et dans la feuille que je partage j'ai bidouillé car la formule ne semble pas fonctionner dans la mise en forme des cellules sans passer par une cellule intermédiaire.

Maintenant je que je vous ai expliqué mon besoin voici mon problème : je pensais que je pourrais faire tous mes tests via des formules Excel mais force est de constater que cela s'avère plus compliqué qu'attendu, et je pense que je vais devoir faire un peu de VBA.

Autant pour les tests numérotés 1 et 5 cela me paraît simple sans passer par du VBA, autant pour les tests 2-3-4 cela me semble impossible ou alors très compliqué.
Pour le moment je m'attaque au test numéro 2 mais si vous avez des indications pour les autres tests je suis preneur.
Donc pour le test numéro 2 "Test du nombre de joueurs hors EU dans l'équipe" je voyais cela comme cela :
- récupérer la liste des licences des joueurs qui sont sélectionnés, puis vérifier si ces joueurs sont hors EU

Malheureusement mes compétences en VBA sont quasi nulles, comme vous pouvez le voir dans les macro j'ai essayé de faire une macro pour parcourir toutes les checkbox de la feuille active mais cela ne fonctionne pas : le code ne rentre jamais dans la boucle For...

VB:

Sub ListerCheckboxClicked()

    Dim obj As OLEObject
    Response = MsgBox("test", vbOK, "MsgBox Demonstration", "DEMO.HLP", 1000)
    
    For Each obj In ActiveSheet.OLEObjects
        Response = MsgBox(obj.Name + " " + obj.Index, vbOK, "MsgBox Demonstration", "DEMO.HLP", 1000)
        If TypeOf obj.Object Is msforms.CheckBox Then
            Response = MsgBox(obj.Name + " " + obj.Index, vbOK, "MsgBox Demonstration", "DEMO.HLP", 1000)
            obj.Object.Caption = "test"
        End If
    Next obj
    
End Sub

De plus si je dois faire du VBA pour un test autant tout tester en VBA, qu'en pensez-vous ?

apocalypse · 15 Juillet 2025

job75 à dit:
On peut repérer la cellule active en la colorant.

PS : au 3ème test j'avais écrit "jour" au lieu de "joueur".

Pas de soucis 😉.
J'ai fais une update pour récupérer le nom et prénom du joueur et l'afficher 😋.

Encore un grand merci pour cette aide si précieuse et surtout impressionnante.

Je ne m'attendais pas à voir quelque chose de si épuré au niveau du code 😆

apocalypse · 15 Juillet 2025

Oh grand job75 🙏
J'ai découvert une nouvelle règle bien spécifique : lors de la j2 2 joueurs ne peuvent pas faire partie de la même équipe si ils ont tous les deux joués dans une équipe inférieure en J1.

Par exemple:
- le joueur X a joué en équipe 3 en J1
- le joueur Y a joué en équipe 2 en J1

Il est impossible d'avoir X et Y en équipe 1 en J2.

Saurais-tu comment gérer ce cas de figure ?

job75 · 15 Juillet 2025

Trop compliqué.

apocalypse · 15 Juillet 2025

job75 à dit:
Trop compliqué.

Je te crois sur parole 😆.

job75 · 15 Juillet 2025

Bien comprendre que plus il y a de contraintes plus il y a de chances qu'on ne trouve plus de joueurs disponibles.

apocalypse · 15 Juillet 2025

job75 à dit:
Bien comprendre que plus il y a de contraintes plus il y a de chances qu'on ne trouve plus de joueurs disponibles.

Ce sont les règles officielles je n'y peux rien 🤣.
Après un joueur généralement ne change pas d'équipe, mais il arrive que pour remplacer un joueur il y ai des modifications du coup pour ne pas tomber dans le piège d'une règle oublié j'essaie de les mettre en place sur ce document

job75 · 16 Juillet 2025

Bonjour apocalypse, le forum,

J'ai mis au point le 6ème test comme vous l'avez demandé au post #47 :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rep$, ac As Range, lig&, licence&, points&, col%, equipe%, division$, r1 As Range, r2 As Range
Dim i&, horsEU%, plage1 As Range, plage2 As Range, jour2 As Range, jour1 As Range, mini1 As Range, mini2 As Range, mini%
rep = "ü" 'caractère Wingdings pour la coche
Set ac = ActiveCell
With [Tableau8] 'tableau structuré, à adapter
    If Intersect(ac, .Columns(4).Resize(, .Columns.Count - 3)) Is Nothing Then Exit Sub
    lig = ac.Row - .Row + 1
    licence = .Cells(lig, 1)
    points = .Cells(lig, 3)
    col = ac.Column - .Column + 1
    equipe = .Cells(-2, col)
    division = .Cells(-1, col)
    If ac = "" Then
        '---1er test---
        Set r1 = [Tableau5] 'tableau structuré
        If Application.CountIf(.Columns(col), rep) = Application.VLookup(division, r1.Columns(1).Resize(, 2), 2, 0) _
            Then MsgBox "L'équipe " & equipe & " est complète...": GoTo 1
        '---2ème test---
        Set r2 = [Tableau1] 'tableau structuré
        If Application.VLookup(licence, r2.Columns(3).Resize(, 4), 4, 0) = rep Then
            For i = 1 To .Rows.Count
                If .Cells(i, col) = rep Then If Application.VLookup(.Cells(i, 1), r2.Columns(3).Resize(, 4), 4, 0) = rep Then horsEU = horsEU + 1
            Next i
            If horsEU = Application.VLookup(division, r1.Columns(1).Resize(, 3), 3, 0) Then MsgBox "Le maximum de joueurs hors EU est atteint...": GoTo 1
        End If
        '---3ème test---
        If Application.CountIf(Intersect(.Cells(-3, col).MergeArea.EntireColumn, ac.EntireRow), rep) _
            Then MsgBox "Ce joueur se trouve déjà dans une autre équipe...": GoTo 1
        '---4ème test---
        Set plage1 = .Cells(-2, 4).Resize(, col - 3) 'ligne des équipes
        Set plage2 = .Cells(lig, 4).Resize(, col - 3)
        i = IIf(Application.CountIf(plage2, rep) > 1, Application.MaxIfs(plage1, plage2, rep), 0) 'NB.SI et MAX.SI.ENS
        If i Then If equipe > i Then MsgBox "Ce joueur doit être au moins dans l'équipe " & i & "...": GoTo 1
        '---5ème test---
        If points < Application.VLookup(division, r1.Columns(1).Resize(, 4), 4, 0) Then MsgBox "Ce joueur n'a pas les points requis pour cette division...": GoTo 1
        '---6ème test---
        Set jour2 = .Cells(-3, col).MergeArea
        If Val(Mid(jour2(1), 2)) > 1 Then
            Set jour1 = .Cells(-3, col - jour2.Count).MergeArea
            Set mini1 = Intersect(jour1.EntireColumn, ac.EntireRow).Find(rep, , xlValues)
            If Not mini1 Is Nothing Then
                Set mini1 = Intersect(mini1.EntireColumn, .Rows(-2)) 'équipe
                For i = 1 To .Rows.Count
                    If .Cells(i, col) = rep Then
                        Set mini2 = Intersect(jour1.EntireColumn, .Rows(i)).Find(rep, , xlValues)
                        If Not mini2 Is Nothing Then
                            Set mini2 = Intersect(mini2.EntireColumn, .Rows(-2)) 'équipe
                            mini = IIf(mini1 < mini2, mini1, mini2)
                            If equipe < mini Then MsgBox "Pour ce joueur essayez une équipe entre " & mini & " et " & jour2.Count & "...": GoTo 1
                        End If
                    End If
                Next i
            End If
        End If
    End If
End With
ac = IIf(ac = "", "ü", "")
1 Application.ScreenUpdating = True 'rafraîchit l'écran
[B8].Select 'la colonne B est masquée
End Sub

A+

apocalypse · 16 Juillet 2025

job75 à dit:

Bonjour apocalypse, le forum,

J'ai mis au point le 6ème test comme vous l'avez demandé au post #47 :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rep$, ac As Range, lig&, licence&, points&, col%, equipe%, division$, r1 As Range, r2 As Range
Dim i&, horsEU%, plage1 As Range, plage2 As Range, jour2 As Range, jour1 As Range, mini1 As Range, mini2 As Range, mini%
rep = "ü" 'caractère Wingdings pour la coche
Set ac = ActiveCell
With [Tableau8] 'tableau structuré, à adapter
    If Intersect(ac, .Columns(4).Resize(, .Columns.Count - 3)) Is Nothing Then Exit Sub
    lig = ac.Row - .Row + 1
    licence = .Cells(lig, 1)
    points = .Cells(lig, 3)
    col = ac.Column - .Column + 1
    equipe = .Cells(-2, col)
    division = .Cells(-1, col)
    If ac = "" Then
        '---1er test---
        Set r1 = [Tableau5] 'tableau structuré
        If Application.CountIf(.Columns(col), rep) = Application.VLookup(division, r1.Columns(1).Resize(, 2), 2, 0) _
            Then MsgBox "L'équipe " & equipe & " est complète...": GoTo 1
        '---2ème test---
        Set r2 = [Tableau1] 'tableau structuré
        If Application.VLookup(licence, r2.Columns(3).Resize(, 4), 4, 0) = rep Then
            For i = 1 To .Rows.Count
                If .Cells(i, col) = rep Then If Application.VLookup(.Cells(i, 1), r2.Columns(3).Resize(, 4), 4, 0) = rep Then horsEU = horsEU + 1
            Next i
            If horsEU = Application.VLookup(division, r1.Columns(1).Resize(, 3), 3, 0) Then MsgBox "Le maximum de joueurs hors EU est atteint...": GoTo 1
        End If
        '---3ème test---
        If Application.CountIf(Intersect(.Cells(-3, col).MergeArea.EntireColumn, ac.EntireRow), rep) _
            Then MsgBox "Ce joueur se trouve déjà dans une autre équipe...": GoTo 1
        '---4ème test---
        Set plage1 = .Cells(-2, 4).Resize(, col - 3) 'ligne des équipes
        Set plage2 = .Cells(lig, 4).Resize(, col - 3)
        i = IIf(Application.CountIf(plage2, rep) > 1, Application.MaxIfs(plage1, plage2, rep), 0) 'NB.SI et MAX.SI.ENS
        If i Then If equipe > i Then MsgBox "Ce joueur doit être au moins dans l'équipe " & i & "...": GoTo 1
        '---5ème test---
        If points < Application.VLookup(division, r1.Columns(1).Resize(, 4), 4, 0) Then MsgBox "Ce joueur n'a pas les points requis pour cette division...": GoTo 1
        '---6ème test---
        Set jour2 = .Cells(-3, col).MergeArea
        If Val(Mid(jour2(1), 2)) > 1 Then
            Set jour1 = .Cells(-3, col - jour2.Count).MergeArea
            Set mini1 = Intersect(jour1.EntireColumn, ac.EntireRow).Find(rep, , xlValues)
            If Not mini1 Is Nothing Then
                Set mini1 = Intersect(mini1.EntireColumn, .Rows(-2)) 'équipe
                For i = 1 To .Rows.Count
                    If .Cells(i, col) = rep Then
                        Set mini2 = Intersect(jour1.EntireColumn, .Rows(i)).Find(rep, , xlValues)
                        If Not mini2 Is Nothing Then
                            Set mini2 = Intersect(mini2.EntireColumn, .Rows(-2)) 'équipe
                            mini = IIf(mini1 < mini2, mini1, mini2)
                            If equipe < mini Then MsgBox "Pour ce joueur essayez une équipe entre " & mini & " et " & jour2.Count & "...": GoTo 1
                        End If
                    End If
                Next i
            End If
        End If
    End If
End With
ac = IIf(ac = "", "ü", "")
1 Application.ScreenUpdating = True 'rafraîchit l'écran
[B8].Select 'la colonne B est masquée
End Sub

A+

Trop fort job75 😁.

Juste pour info pour mon entourage je te surnomme "Dieu de l'Excel" 😆

bsalv · 16 Juillet 2025

bonjour le fil,

moi, je préfère une autre mise à page, on a le tableau "tabel2" avec tous les joueurs et chaque jeu, on peut choisir sa division et c'est facile, on n'a qu'un choix unique par joueur par jeu. Puis on a ces plages juste au dessus dans lesquelles on vérifie chaque fois des règles, par exemple F28:N34 = max 4 joueurs de la même division, F37:N43 = max 1 joueur hors EU, ... . Comme ça, on verifie chaque règle avec des MFCs et au bout s'il n'y a aucune infraction, c'est okay ...
Cela est plus facile à gèrer et si nécessaire, VBA peut boucler tout pour trouver une solution. (Pour le moment une macro stupide "alea" et juste 2 testes)

apocalypse · 16 Juillet 2025

bsalv à dit:
bonjour le fil,

moi, je préfère une autre mise à page, on a le tableau "tabel2" avec tous les joueurs et chaque jeu, on peut choisir sa division et c'est facile, on n'a qu'un choix unique par joueur par jeu. Puis on a ces plages juste au dessus dans lesquelles on vérifie chaque fois des règles, par exemple F28:N34 = max 4 joueurs de la même division, F37:N43 = max 1 joueur hors EU, ... . Comme ça, on verifie chaque règle avec des MFCs et au bout s'il n'y a aucune infraction, c'est okay ...
Cela est plus facile à gèrer et si nécessaire, VBA peut boucler tout pour trouver une solution. (Pour le moment une macro stupide "alea" et juste 2 testes)

Hello,
Je pensais faire une mise en page comme cela au départ mais force est de constater que je préfère grandement ce qu'a fait Job75.
Les règles sont assez complexe du coup il faut je pense forcément passer par du VBA, on peut aussi avoir plusieurs équipe par division c'est pour cela que les vérifications se font par rapport au numéro de l'équipe et non la division.

C'est compliqué le tennis de table... Et étrangement je ne trouve rien (application ou autre) pour gérer cela, ou même les tournois 😅.

apocalypse · 16 Juillet 2025

Hello job75,

Je suis en train de m'amuser à rajouter une fonctionnalité: ajouter les joueurs sélectionnés dans la feuille de l'équipe individuelle.
Je crois que je m'en sors par mal pour le moment même si clairement c'est moins esthétique que ton code 😅😅😅.

Par contre je crois que je vais bloquer sur le fait de retirer le joueur de la feuille individuelle.
Dans le cas où l'utilisateur sélectionne un joueur par inadvertance, le joueur va être ajouté dans la feuille individuelle de l'équipe, cependant je veux le supprimer de la feuille individuelle si le joueur est désélectionné de l'équipe ET qu'il n'a aucun résultat dans le tableau de l'équipe (dans le cas où il a déjà joué dans l'équipe et qu'il a eu des résultats il faut le laisser).

update: ça marche pas super en fait ce que j'ai fait ^^, ça marche en J1 mais quand en j2 je sélectionne un joueur différent de ceux de la J1 ça écrase les joueurs (normal vu que je me base sur le nombre de joueurs de la journée 🥲)

bsalv · 17 Juillet 2025

un essai,
Avez-vous des données anonymisées d'un tournoi qu'on peut utiliser pour simuler cela ?
Ce dernier règle, il me paraît bizarre, donc dans les premiers jeux, il faut presque ignorer les equipes avec un numéro assez grand ...

apocalypse · 17 Juillet 2025

bsalv à dit:
un essai,
Avez-vous des données anonymisées d'un tournoi qu'on peut utiliser pour simuler cela ?
Ce dernier règle, il me paraît bizarre, donc dans les premiers jeux, il faut presque ignorer les equipes avec un numéro assez grand ...

Ce sont les règles officielles du championnat par équipe de tennis de table.

La dernière règle est là pour éviter par exemple que des joueurs forts qui normalement vont jouer en équipe 1, ne renforcer d'autres équipes lors de la première journée.

Avec cette règle on évite au maximum d'avoir des renforts de joueurs dans les équipes.

Je pense qu'il y a eu des abus et donc la fftt a mis cette règle en place.

apocalypse · 17 Juillet 2025

J'ai réussi à faire ce que je voulais avec l'ajout et la suppression des joueurs dans les feuilles d'équipes individuelle 😁.
Je pense que le code n'est pas très optimisé mais bon je suis assez content pour ma première fois en VBA 😋

apocalypse · 17 Juillet 2025

Il y un problème avec ce que j'ai fait.
Je ne sais pas pour quelle raison mais voici ce que je fais :
1- je sélectionne le joueur A pour l'équipe 2 pour la J1
2- je sélectionne le joueur A pour l'équipe 1 pour la J1
3- j'ai un message d'erreur d'une règle (normal) cependant il ajoute quand même le joueur dans la feuille de l'équipe 1 car je ne sais pour quelle raison il passe par ce code :

VB:

'---on retire la licence du joueur de la feuille de l'équipe si il n'a pas de résultat inscrit dans le tableau de l'équipe---
If Not ajouter_joueur Then

XL 2019 VBA newbie

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Occasionnel

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

Pièces jointes

Discussions similaires

Nous accordons de l'importance à votre vie privée