Autres Additionner des nombres de deux colonnes avec un critère

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 !

Ommagawi

XLDnaute Junior
Bonjour,
Dans mon exemple je souhaite faire la somme des stagiaires par formateurs.
Peut-on le faire avec un TCD ou faut-il utiliser une macro ?
Je ne peux pas utiliser la formule SI car les formateurs sont trop nombreux (plus de 50).
Merci de votre coopération.
 

Pièces jointes

Solution
Bonjour Ommagawi, le forum,

Le code que vous indiquez est clair : il faut un tableau structuré.

Or la feuille CUMULFORMATEUR est la seule feuille où il n'y en a pas !!!

Créez-le,, fermez et rouvrez le fichier et activez la feuille.

PS : pourquoi avoir ajouté Sheets("FORMATEUR").Unprotect qui ne sert strictement à rien ?

A+
En ajoutant de nouveaux critères c'est sans fin 🙄
Bonjour job75,
C'est vrai et je m'en excuse. Je pensais ne pas en avoir besoin mais c'est indispensable pour les statistiques annuelles. Je n'ai pas réussit à le faire avec les TCD c'est pourquoi je me tourne à nouveau vers toi (ou la communauté) pour me donner une solution en VBA.
Ce n'est pas facile et ça prend du temps, mais ça m'ôterait une grosse épine du pied !
Merci de ta contribution et je comprends tout à fait si tu ne donne pas suite.
Bonne journée à toi.
 
Bonjour Ommagawi,

Choisissez l'année dans la liste de validation en E1, le code de la 2ème feuille :
VB:
Private Sub Worksheet_Activate()
Dim An, d As Object, tablo, i&, j%, x$, a, b, resu(), n&
An = [E1] 'cellule à adapter
If LCase(An) = "toutes" Then An = "####" '4 chiffres
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("FORMATEUR").[B1].CurrentRegion.Resize(, 6)
For i = 2 To UBound(tablo)
    If LCase(tablo(i, 5)) = "validé" Then 'compare en minuscules
        If tablo(i, 6) Like An Then
            For j = 2 To 3
                x = tablo(i, j)
                If x <> "" Then d(x) = d(x) + Val(tablo(i, 4))
            Next j
        End If
    End If
Next i
'---transposition---
If d.Count Then
    a = d.keys: b = d.items
    ReDim resu(UBound(a), 1) 'base 0
    For n = 0 To UBound(a)
        resu(n, 0) = a(n)
        resu(n, 1) = b(n)
    Next n
End If
'---restitution---
Application.EnableEvents = False 'désactive les évènements
With ListObjects(1).Range.Resize(, 2) 'tableau structuré
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    With .Rows(2)
        If n Then
            .Resize(n) = resu
            .Resize(n).Sort .Columns(2), xlDescending, Header:=xlYes 'tri décroissant
        End If
        .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
    End With
    On Error Resume Next 'si aucune SpecialCell
    .SpecialCells(xlCellTypeBlanks).Delete xlUp 'supprime les lignes vides s'il y en a
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Activate 'lance la macro
End Sub
Avec la macro Worksheet_Change le code s'exécute quand on modifie ou valide une cellule quelconque.

A+
 

Pièces jointes

Dernière édition:
Bonjour Ommagawi,

Choisissez l'année dans la liste de validation en E1, le code de la 2ème feuille :
VB:
Private Sub Worksheet_Activate()
Dim An, d As Object, tablo, i&, j%, x$, a, b, resu(), n&
An = [E1] 'cellule à adapter
If LCase(An) = "toutes" Then An = "####" '4 chiffres
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("FORMATEUR").[B1].CurrentRegion.Resize(, 6)
For i = 2 To UBound(tablo)
    If LCase(tablo(i, 5)) = "validé" Then 'compare en minuscules
        If tablo(i, 6) Like An Then
            For j = 2 To 3
                x = tablo(i, j)
                If x <> "" Then d(x) = d(x) + Val(tablo(i, 4))
            Next j
        End If
    End If
Next i
'---transposition---
If d.Count Then
    a = d.keys: b = d.items
    ReDim resu(UBound(a), 1) 'base 0
    For n = 0 To UBound(a)
        resu(n, 0) = a(n)
        resu(n, 1) = b(n)
    Next n
End If
'---restitution---
Application.EnableEvents = False 'désactive les évènements
With ListObjects(1).Range.Resize(, 2) 'tableau structuré
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    With .Rows(2)
        If n Then
            .Resize(n) = resu
            .Resize(n).Sort .Columns(2), xlDescending, Header:=xlYes 'tri décroissant
        End If
        .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
    End With
    On Error Resume Next 'si aucune SpecialCell
    .SpecialCells(xlCellTypeBlanks).Delete xlUp 'supprime les lignes vides s'il y en a
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Activate 'lance la macro
End Sub
Avec la macro Worksheet_Change le code s'exécute quand on modifie ou valide une cellule quelconque.

A+
Merci mille fois job75. Et encore bonne année. PS : excuse moi pour le tutoiement, mais c'est naturel. Bon vent à toi.
 
Merci mille fois job75. Et encore bonne année. PS : excuse moi pour le tutoiement, mais c'est naturel. Bon vent à toi.
Bonjour Ommagawi,

Choisissez l'année dans la liste de validation en E1, le code de la 2ème feuille :
VB:
Private Sub Worksheet_Activate()
Dim An, d As Object, tablo, i&, j%, x$, a, b, resu(), n&
An = [E1] 'cellule à adapter
If LCase(An) = "toutes" Then An = "####" '4 chiffres
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("FORMATEUR").[B1].CurrentRegion.Resize(, 6)
For i = 2 To UBound(tablo)
    If LCase(tablo(i, 5)) = "validé" Then 'compare en minuscules
        If tablo(i, 6) Like An Then
            For j = 2 To 3
                x = tablo(i, j)
                If x <> "" Then d(x) = d(x) + Val(tablo(i, 4))
            Next j
        End If
    End If
Next i
'---transposition---
If d.Count Then
    a = d.keys: b = d.items
    ReDim resu(UBound(a), 1) 'base 0
    For n = 0 To UBound(a)
        resu(n, 0) = a(n)
        resu(n, 1) = b(n)
    Next n
End If
'---restitution---
Application.EnableEvents = False 'désactive les évènements
With ListObjects(1).Range.Resize(, 2) 'tableau structuré
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    With .Rows(2)
        If n Then
            .Resize(n) = resu
            .Resize(n).Sort .Columns(2), xlDescending, Header:=xlYes 'tri décroissant
        End If
        .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
    End With
    On Error Resume Next 'si aucune SpecialCell
    .SpecialCells(xlCellTypeBlanks).Delete xlUp 'supprime les lignes vides s'il y en a
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Activate 'lance la macro
End Sub
Avec la macro Worksheet_Change le code s'exécute quand on modifie ou valide une cellule quelconque.

A+
Bonjour job75, c'est encore moi.
Ton code (qui marche très bien sur ChargeF(4) ), je l'ai recopié sur mon fichier ESSAI ci-joint.
J'ai un problème avec With ListObjects(1).Range.Resize(, 2) 'tableau structuré
Erreur d'exécution '9'
L'indice n'apparait pas à la sélection
A quoi est ce dû ?
Si tu as encore un peu de patience ! Merci
 

Pièces jointes

Bonjour Ommagawi, le forum,

Le code que vous indiquez est clair : il faut un tableau structuré.

Or la feuille CUMULFORMATEUR est la seule feuille où il n'y en a pas !!!

Créez-le,, fermez et rouvrez le fichier et activez la feuille.

PS : pourquoi avoir ajouté Sheets("FORMATEUR").Unprotect qui ne sert strictement à rien ?

A+
 
Bonjour Ommagawi, le forum,

Le code que vous indiquez est clair : il faut un tableau structuré.

Or la feuille CUMULFORMATEUR est la seule feuille où il n'y en a pas !!!

Créez-le,, fermez et rouvrez le fichier et activez la feuille.

PS : pourquoi avoir ajouté Sheets("FORMATEUR").Unprotect qui ne sert strictement à rien ?

A+
Merci job75. Ca marche.
Quand l'onglet FORMATEUR est "protégé" (c'est le cas), on a un code d'erreur. En le "déprotégeant" ca marche.
Ai je bien fait ?
Encore merci. Bonne journée.
 
- 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

Retour