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

O

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

  • ChargeF.xlsx
    11.9 KB · Affichages: 9
Solution
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+
Trier par date Trier par votes
O

Ommagawi

XLDnaute Junior
job75 à dit:
En ajoutant de nouveaux critères c'est sans fin :rolleyes:
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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

  • ChargeF(4).xlsm
    28.2 KB · Affichages: 2
Dernière édition:
Vote positif 0 Vote négatif
O

Ommagawi

XLDnaute Junior
job75 à dit:
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+
Cliquez pour agrandir...
Merci mille fois job75. Et encore bonne année. PS : excuse moi pour le tutoiement, mais c'est naturel. Bon vent à toi.
 
Vote positif 0 Vote négatif
O

Ommagawi

XLDnaute Junior
Ommagawi à dit:
Merci mille fois job75. Et encore bonne année. PS : excuse moi pour le tutoiement, mais c'est naturel. Bon vent à toi.
Cliquez pour agrandir...
job75 à dit:
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+
Cliquez pour agrandir...
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

  • ESSAI.xlsm
    863.7 KB · Affichages: 3
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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+
 
Vote positif 0 Vote négatif
Solution
O

Ommagawi

XLDnaute Junior
job75 à dit:
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+
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif

Discussions similaires

G
  • Question
XL 2019 additionner des cellules en fonction
Réponses
7
Affichages
174
JHA
J
T
  • Question
XL 2013 Validation des dates dans Excel : Comment restreindre la saisie
Réponses
7
Affichages
413
Mikakawel
Mikakawel
P
  • Question
Microsoft 365 Fonction filtre avec si
2 3
Réponses
40
Affichages
2 K
Pulpito
P
T
  • Résolu(e)
XL 2021 Masquer des colonnes et affichage avec MDP
Réponses
11
Affichages
671
ThomAnalyses
T
N
  • Résolu(e)
XL 2021 Somme cumulative en prenant en compte une colonne sur 3
Réponses
3
Affichages
261
NLSCt
N
O
  • Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
430
olivieroma
O
M
  • Question
Microsoft 365 Concatener avec Si et avec Index
Réponses
5
Affichages
281
mapomme
mapomme
L
  • Résolu(e)
XL 2016 Formule pour calculer une somme avec des plages décalées
Réponses
2
Affichages
223
Linda42
L
T
  • Résolu(e)
XL 2019 Petit souci avec un TCD
Réponses
5
Affichages
344
ThierryP
T
ahlem&2019
  • Question
XL 2016 EXCEL 2016 MFC sur deux colonnes excel
Réponses
7
Affichages
334
goube
goube

Membres actuellement en ligne

20 membres et 300 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 634
Messages
2 111 435
Membres
111 136
dernier inscrit
Ahmad Ibnou