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
Bonjour apocalypse, le forum,

Pour alimenter les feuilles d'équipe le plus simple est d'utiliser cette macro dans ThisWorkbook :
VB: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim rep$, d As Object, col%, lig&, categorie$, x$
If Not Sh.Name Like "?quipe*#" Then Exit Sub
rep = "ü" 'caractère Wingdings pour la coche
Set d = CreateObject("Scripting.Dictionary")
With [Tableau8] 'tableau structuré de la feuille "Gestion"
    For col = 4 To .Columns.Count
        If .Cells(-2, col) = Val(Right(Sh.Name, 1)) Then
            For lig = 1 To .Rows.Count
                If .Cells(lig, col) = rep Then
                    categorie = Application.VLookup(.Cells(lig, 1), [Tableau1].Columns(3).Resize(, 2), 2, 0)
                    x = .Cells(lig, 2) & Chr(1) & .Cells(lig, 1) & Chr(1) & categorie & Chr(1) & .Cells(lig, 3)
                    d(x) = x
                End If
            Next lig
        End If
    Next col
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sh.ListObjects(1).Range
    If Not .ListObject.DataBodyRange Is Nothing Then .ListObject.DataBodyRange.Delete xlUp 'RAZ
    If d.Count Then
        With .Cells(2, 1).Resize(d.Count)
            .Value = Application.Transpose(d.items)
            .TextToColumns .Cells, Other:=True, OtherChar:=Chr(1) 'commande Convertir
        End With
    End If
    .Sort .Columns(1), xlAscending, Header:=xlYes 'tri sur les noms
End With
End Sub
Elle se déclenche quand on active une des feuilles.

Les joueurs cochés en feuille "Gestion" sont listés sans doublon quelle que soit la journée J1 J2 J3...

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Bien sûr si des données ont été entrées dans les colonnes G:M il faut les récupérer :
VB: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim rep$, d As Object, col%, lig&, categorie$, x$, tablo, i As Variant, j%
If Not Sh.Name Like "?quipe*#" Then Exit Sub
rep = "ü" 'caractère Wingdings pour la coche
Set d = CreateObject("Scripting.Dictionary")
With [Tableau8] 'tableau structuré de la feuille "Gestion"
    For col = 4 To .Columns.Count
        If .Cells(-2, col) = Val(Right(Sh.Name, 1)) Then
            For lig = 1 To .Rows.Count
                If .Cells(lig, col) = rep Then
                    categorie = Application.VLookup(.Cells(lig, 1), [Tableau1].Columns(3).Resize(, 2), 2, 0)
                    x = .Cells(lig, 2) & Chr(1) & .Cells(lig, 1) & Chr(1) & categorie & Chr(1) & .Cells(lig, 3)
                    d(x) = x
                End If
            Next lig
        End If
    Next col
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sh.ListObjects(1).Range
    tablo = .Value 'mémorise
    If Not .ListObject.DataBodyRange Is Nothing Then .ListObject.DataBodyRange.Delete xlUp 'RAZ
    If d.Count Then
        With .Cells(2, 1).Resize(d.Count)
            .Value = Application.Transpose(d.items)
            .TextToColumns .Cells, Other:=True, OtherChar:=Chr(1) 'commande Convertir
        End With
    End If
    .Sort .Columns(1), xlAscending, Header:=xlYes 'tri sur les noms
End With
'---récupère les données mémorisées des colonnes G:M---
With Sh.ListObjects(1).Range
    For lig = 2 To .Rows.Count
        i = Application.Match(.Cells(lig, 2), Application.index(tablo, , 2), 0)
        If IsNumeric(i) Then
            For col = 6 To 12
                .Cells(lig, col) = tablo(i, col)
            Next col
        End If
    Next lig
End With
End Sub
Dans le fichier (2) joint sur la feuille "Équipe 1" le texte "Bravissimo" est récupéré pour le joueur "c c".

A+
 

Pièces jointes

Vote positif 0 Vote négatif
job75 à dit:
Bien sûr si des données ont été entrées dans les colonnes G:M il faut les récupérer :
VB: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim rep$, d As Object, col%, lig&, categorie$, x$, tablo, i As Variant, j%
If Not Sh.Name Like "?quipe*#" Then Exit Sub
rep = "ü" 'caractère Wingdings pour la coche
Set d = CreateObject("Scripting.Dictionary")
With [Tableau8] 'tableau structuré de la feuille "Gestion"
    For col = 4 To .Columns.Count
        If .Cells(-2, col) = Val(Right(Sh.Name, 1)) Then
            For lig = 1 To .Rows.Count
                If .Cells(lig, col) = rep Then
                    categorie = Application.VLookup(.Cells(lig, 1), [Tableau1].Columns(3).Resize(, 2), 2, 0)
                    x = .Cells(lig, 2) & Chr(1) & .Cells(lig, 1) & Chr(1) & categorie & Chr(1) & .Cells(lig, 3)
                    d(x) = x
                End If
            Next lig
        End If
    Next col
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sh.ListObjects(1).Range
    tablo = .Value 'mémorise
    If Not .ListObject.DataBodyRange Is Nothing Then .ListObject.DataBodyRange.Delete xlUp 'RAZ
    If d.Count Then
        With .Cells(2, 1).Resize(d.Count)
            .Value = Application.Transpose(d.items)
            .TextToColumns .Cells, Other:=True, OtherChar:=Chr(1) 'commande Convertir
        End With
    End If
    .Sort .Columns(1), xlAscending, Header:=xlYes 'tri sur les noms
End With
'---récupère les données mémorisées des colonnes G:M---
With Sh.ListObjects(1).Range
    For lig = 2 To .Rows.Count
        i = Application.Match(.Cells(lig, 2), Application.index(tablo, , 2), 0)
        If IsNumeric(i) Then
            For col = 6 To 12
                .Cells(lig, col) = tablo(i, col)
            Next col
        End If
    Next lig
End With
End Sub
Dans le fichier (2) joint sur la feuille "Équipe 1" le texte "Bravissimo" est récupéré pour le joueur "c c".

A+
Cliquez pour agrandir...
Au risque de me répéter: beaucoup trop fort 😅.
Merci 👌
 
Vote positif 0 Vote négatif
actuellement je dois rentrer la liste des membres dans 2 feuilles ("Liste des membres", "Gestion").
Dans "Liste des membres" je rentre toutes les informations, et dans "Gestion" je rentre uniquement le numéro de licence et je récupère des informations de la feuille "Liste des membres".

Est-il possible de copier directement les informations voulues depuis "Liste des membres" vers "Gestion" sans passer par du VBA ?
Comme cela je n'ai qu'à entrer une fois les informations.
 
Vote positif 0 Vote négatif
job75 à dit:
En Gestion!C8 => =INDEX(Tableau1;LIGNES(8:8);3)
En Gestion!D8 => =INDEX(Tableau1;LIGNES($8:8);1)
En Gestion!E8 => =INDEX(Tableau1;LIGNES($8:8);5)
Cliquez pour agrandir...
Yep c'est ce que j'avais tenté mais quand j'ajoute un joueur dans la liste cela n'impacte pas la feuille "Gestion".
Je veux éviter la double saisie et vraiment que "Gestion" soit un miroir de ce qu'il y a dans la liste des joueurs (avec des informations en moins vu que plus pour aider dans le choix des équipes toutes les informations ne sont pas nécessaires).
 
Vote positif 0 Vote négatif
Bon vous vous rendez compte que mettre des formules en colonnes C D E de la feuille "Gestion" ne va pas.

Il faut faire pour cette feuille la même chose que pour les feuilles d'équipes :
VB: 
Private Sub Worksheet_Activate()
Dim d As Object, lig&, x$, tablo, i As Variant, cc%, col%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With [Tableau1] 'tableau structuré de la feuille "Liste des joueurs"
    For lig = 1 To .Rows.Count
        If .Cells(lig, 1) <> "" Then
            x = .Cells(lig, 3) & Chr(1) & .Cells(lig, 1) & " " & .Cells(lig, 2) & Chr(1) & .Cells(lig, 5)
            d(x) = x
        End If
    Next lig
End With
'---restitution---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With [Tableau8]
    tablo = .Value 'mémorise
    If Not .ListObject.DataBodyRange Is Nothing Then .Delete xlUp 'RAZ
    If d.Count Then
        With .Cells(1).Resize(d.Count)
            .Value = Application.Transpose(d.items)
            .TextToColumns .Cells, Other:=True, OtherChar:=Chr(1) 'commande Convertir
        End With
    End If
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri sur les noms/prénoms
End With
'---récupère les données mémorisées à partir de la 4ème colonne---
With [Tableau8]
    cc = .Columns.Count
    For lig = 1 To .Rows.Count
        i = Application.Match(.Cells(lig, 1), Application.index(tablo, , 1), 0)
        If IsNumeric(i) Then
            For col = 4 To cc
               If tablo(i, col) <> "" Then  .Cells(lig, col) = tablo(i, col)
            Next col
        End If
    Next lig
End With
End Sub
La couleur attribuée à la dernière cellule active n'est pas conservée, ça n'a aucune importance.
 

Pièces jointes

Vote positif 0 Vote négatif
je travaille sur une autre piste et pour le moment tout est dans 2 tableaux structurés, donc si on ajoute/supprime des joueurs ou des équipes, il ne faut pas modifier des choses. Et je prévois 10 jeux, mais pour le moment, on n'utilise que 7.
Avec les données de hier = 22 joueurs par jour * 7 jours = 154 joueurs à assigner, VBA sait les assigner sauf quelqu'uns. Pour ce moment, ce n'est pas encore très intelligent, je ne comprends pas encore bien le dernier règle. Veut-cela dire qu'on a une séquence descendant dans chaque ligne , colonnes AH:AQ ? Voyez-vous des erreurs ?
Plage G6😛11 compte les joueurs par équipe par jour, plage Q6:Z11 compte les "hors EU" par equipe par jour. G3 et Q3 comptent les infractions.
Puis les plages AR6:AZ37 et BB6:BK37 vérifient ce fameux règle et les points minimaux.
La plage AH6:AQ37 est une solution sans infractions pour le moment, mais il manquent encore 7 joueurs.
 

Pièces jointes

Vote positif 0 Vote négatif
Re-bonjour à tous,

Les vacances sont terminés donc je reprends le projet 😁.
En effectuant quelques tests je me suis aperçu qu'il y a des cas qui ne fonctionnent pas pour le test 4 (sans doute avais-je mal spécifier le besoin 😅)

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)
        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
                ac.Interior.Color = RGB(121, 15, 2) 'colore en rouge
                MsgBox joueur + " doit être au moins dans l'équipe " & i & "...": GoTo 1
            End If
        End If

En effet si je fais jouer le joueur A dans cette configuration :
- J1 => Équipe 4
- J2 => Équipe 4
- J3 => Équipe 3 (ici le joueur a l'obligation de jouer à minimum en équipe 4, c'est-à-dire qu'il peut jouer en équipe 4 ou 3 ou 2 ou 1 car il a fait 2 matchs en équipe 4)
- J4 => Équipe 3 (ici le joueur a l'obligation de jouer à minimum en équipe 3, c'est-à-dire qu'il peut jouer en équipe 3 ou 2 ou 1 car il a fait 2 matchs en équipe 3)
- J5 => le joueur ne devrait pas pouvoir jouer dans une équipe en dessous de la 3, donc il ne peut jouer qu'en équipe 1-2-3 mais ce n'est pas le cas là car le test l'autorise à jouer en équipe 4

Autre cas :

- J1 => Équipe 3
- J2 => Équipe 3
- J3 => Équipe 2 (ici le joueur a l'obligation de jouer à minimum en équipe 3, c'est-à-dire qu'il peut jouer en équipe 1 ou 2 ou 3 car il a fait 2 matchs en équipe 3)
- J4 => Équipe 1 (ici le joueur a l'obligation de jouer à minimum en équipe 3, c'est-à-dire qu'il peut jouer en équipe 1 ou 2 ou 3 car il a fait 2 matchs en équipe 3)
- J5 => il ne peut jouer qu'en 1 ou 2 car il a fait 2 matchs au dessus de la 3 avec J3 et J4 (actuellement le test 4 dit que c'est équipe 3)

- J6 => si en J5 il a joué en 1, en J6 il ne peut jouer qu'en 1
si en J5 il a joué en 2, en J6 il ne peut jouer qu'en 1 ou 2

Je vais essayer de résoudre ça de mon côté mais j'ai le sentiment que je vais coder une usine à gaz 😆.
 

Pièces jointes

Vote positif 0 Vote négatif
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 & "...": GoTo 1
            End If
        End If
Avec déclaration des nouvelles variables n et a().

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Solution
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
618
Orson83
Orson83
Retour