XL 2019 VBA newbie

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

apocalypse

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

Pièces jointes

Solution
job75
Bonjour apocalypse, le forum,

En effet il faut corriger le 4ème test comme suit :
VB: 
        '---4ème test sur le brûlage (cas d'un joueur ayant joué 2 fois dans une équipe supérieure)---
        Set plage1 = .Cells(-2, 4).Resize(, col - 3) 'ligne des équipes
        Set plage2 = .Cells(lig, 4).Resize(, col - 3)
        If Application.CountIf(plage2, rep) > 1 Then
            For i = 1 To plage2.Count
                If plage2(i) = rep Then ReDim Preserve a(n): a(n) = plage1(i): n = n + 1
            Next i
            i = Application.Small(a, 2) 'PETITE.VALEUR
            If equipe > i Then
                ac.Interior.Color = RGB(121, 15, 2) 'colore en rouge
                MsgBox joueur + " doit être au moins dans l'équipe " & i &...
Trier par date Trier par votes
job75 à dit:
Bonjour apocalypse, le forum,

Voyez le fichier joint et la macro de la feuille "Gestion" :
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, i&, horsEU%
rep = "ü" 'caractère Wingdings pour la coche
Set ac = ActiveCell
With [Tableau8] 'tableau structuré, à adapter
    If Intersect(ac, .Columns(4).Resize(, 12)) 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 jour se trouve déjà dans une autre équipe...": 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
    End If
End With
ac = IIf(ac = "", "ü", "")
1 [B14].Select 'la colonne B est masquée
End Sub
Je ne sais pas comment écrire le code du 4ème test car je n'ai pas compris ce que vous voulez.

A+
Cliquez pour agrandir...
J'ai envie de rentrer chez moi tester car ça me surprend que tout rentre dans si peu de ligne de code 😅.

Vite que je sois chez moi ahah.

En tout cas merci pour l'aide.
Le 4eme test ça doit être cela: si un joueur a par exemple joué 2 journée (consécutives ou non) dans une équipe, il ne peut plus jouer dans une équipe inférieure.
Par exemple joueur A joue en équipe 2 journée 1, ensuite en équipe 3 journée 2, et journée 3 il joue en équipe 2. Le reste des journées il ne pourra jouer qu'en équipe 1 ou 2.
 
Vote positif 0 Vote négatif
apocalypse à dit:
Le 4eme test ça doit être cela: si un joueur a par exemple joué 2 journée (consécutives ou non) dans une équipe, il ne peut plus jouer dans une équipe inférieure.
Par exemple joueur A joue en équipe 2 journée 1, ensuite en équipe 3 journée 2, et journée 3 il joue en équipe 2. Le reste des journées il ne pourra jouer qu'en équipe 1 ou 2.
Cliquez pour agrandir...
Ce n'est pas cohérent, le reste des journées il devra jouer en équipes 2, 3, 4, 5, 6 non ?
 
Vote positif 0 Vote négatif
apocalypse à dit:
J'ai peut être pas été assez précis sur le inférieure, 1>2>3>4 etc, si il joue 2 fois en 2 il ne peut pas jouer dans une équipe inférieure sous peine de renforcer injustement une équipe plus faible
Cliquez pour agrandir...
J'ajouterai même que c'est plus compliqué que ça, si il joue en 1, puis en 2 après il ne peut pas jouer en dessous de 2 (donc interdit de jouer en 3-4-5 etc)
 
Vote positif 0 Vote négatif
Alors premièrement je suis bluffé job75, mais genre vraiment 😅.
Je vais regarder en détail comment tu as fait pour comprendre cependant je pense qu'on est dans le cas que j'ai évoquer non ?
Je veux dire que ton code fonctionne parfaitement mais si j'ajoute une 3ème journée je dois adapter le code ,
 
Vote positif 0 Vote négatif
apocalypse à dit:
Alors premièrement je suis bluffé job75, mais genre vraiment 😅.
Je vais regarder en détail comment tu as fait pour comprendre cependant je pense qu'on est dans le cas que j'ai évoquer non ?
Je veux dire que ton code fonctionne parfaitement mais si j'ajoute une 3ème journée je dois adapter le code ,
Cliquez pour agrandir...
Même pas je peux ajouter des journées et c'est pris en compte, incroyable jb75 😅
 
Vote positif 0 Vote négatif
Pour le test 4 celui-ci fonctionne bien chez moi mais vérifiez chez vous car j'ai dû ajouter un rafraîchissement d'écran :
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, i&, horsEU%, plage1 As Range, plage2 As Range
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 jour 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
    End If
End With
ac = IIf(ac = "", "ü", "")
1 Application.ScreenUpdating = True 'rafraîchit l'écran
[B14].Select 'la colonne B est masquée
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
apocalypse à dit:
Même pas je peux ajouter des journées et c'est pris en compte, incroyable jb75 😅
Cliquez pour agrandir...
Je voulais remplacer la ligne de code
VB: 
1 [B14].Select 'la colonne B est masquée
par
Code: 
Cells(Target.Row, Target.Column + 1).Select

pour rester à côté de ce que l'utilisateur vient de sélectionner mais j'ai cette erreur 🥲

1752572971594.png
 
Vote positif 0 Vote négatif
Vote positif 0 Vote négatif
job75 à dit:
Pour le test 4 celui-ci fonctionne bien chez moi mais vérifiez chez vous car j'ai dû ajouter un rafraîchissement d'écran :
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, i&, horsEU%, plage1 As Range, plage2 As Range
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 jour 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
    End If
End With
ac = IIf(ac = "", "ü", "")
1 Application.ScreenUpdating = True 'rafraîchit l'écran
[B14].Select 'la colonne B est masquée
End Sub
Cliquez pour agrandir...
Wow trop rapide vous êtes 😆.
Je m'en vais tester cela très rapidement.

MERCI.
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

G
  • Résolu(e)
Microsoft 365 Problème de classement final
Réponses
9
Affichages
169
globule
G
D
  • Question Question
Microsoft 365 Tirage aléatoire Pétanque
Réponses
1
Affichages
243
vgendron
vgendron
B
  • Question Question
XL 2019 Conserver les formules qui sont enregistrées dans des cellules
Réponses
8
Affichages
334
Phil69970
Phil69970
S
  • Question Question
XL 2019 Fichier de tirage au sort sans doublons avec valeurs en plus
Réponses
1
Affichages
316
sylvanu
sylvanu
P
  • Question Question
Microsoft 365 aide pour tirage aléatoire en triplette ET doublette
Réponses
4
Affichages
537
pointeur
P
M
  • Question Question
XL pour MAC Créer un tirage au sort
Réponses
5
Affichages
1 K
moket07
M
piga25
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
476
piga25
piga25
P
  • Résolu(e)
XL 2021 Requête API - VBA Excel - Parse JSON
Réponses
2
Affichages
346
picc
P
G
  • Question Question
XL 2021 Macro pour changer les titres de fichier d'archive
Réponses
3
Affichages
489
fanch55
fanch55
M
  • Question Question
XL 2021 Générateur Tournoi Ecole de Rugby
Réponses
5
Affichages
637
Magis
M
T
  • Question Question
XL 2019 mini championnat
Réponses
2
Affichages
589
tigre5
T
M
  • Résolu(e)
XL 2021 VBA Ajouter ligne tableau + autres cellules hors tableau
Réponses
3
Affichages
121
sylvanu
sylvanu
D
  • Question Question
Microsoft 365 Gestion championnat billard Français
2
Réponses
18
Affichages
1 K
drenek35
D
Y
  • Question Question
XL 2019 macro pour dupliquer un tableau
Réponses
3
Affichages
391
Yogean
Y
Z
  • Résolu(e)
Microsoft 365 (résolu) Etablir un classement avec des ex-aequo sur la base d'une autre valeur
Réponses
2
Affichages
396
zedude
Z
N
  • Question Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
757
Nel'
N
Z
  • Résolu(e)
Microsoft 365 (résolu) Position d'une valeur max dans un tableau avec ex-aequo
2
Réponses
15
Affichages
738
crocrocro
C
G
  • Résolu(e)
Microsoft 365 Consolidation données depuis des feuilles
Réponses
2
Affichages
362
gpion
G
DAVID-44-
  • Question Question
Microsoft 365 Effacer (et non supprimer) une ligne suivant texte.
Réponses
6
Affichages
177
DAVID-44-
DAVID-44-
Orson83
  • Question Question
XL 2021 Filtrer un tableau structuré avec protection
2 3
Réponses
31
Affichages
619
Orson83
Orson83
Retour