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

[Ommagawi]

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.

 

[Ommagawi]

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.

 

[job75]

Bonjour Ommagawi,

Choisissez l'année dans la liste de validation en E1, le code de la 2ème feuille :

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+

 

[Ommagawi]

Bonjour Ommagawi,

Choisissez l'année dans la liste de validation en E1, le code de la 2ème feuille :

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.

 

[Ommagawi]

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 :

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

 

[job75]

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+

 

[Ommagawi]

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.

 

[job75]

Quand l'onglet FORMATEUR est "protégé" (c'est le cas), on a un code d'erreur. En le "déprotégeant" ca marche.

Oui en effet, pour utiliser CurrentRegion il ne faut pas que la feuille soit protégée.

Et vous avez choisi votre post #21 comme solution de ce fil, c'est bien sûr une erreur, merci de corriger.