Addition par catégories

bonsoir à tous

je souhaite continuer à perfectionner mon fichier

dans le fichier ci joint on trouve des onglets de noms de personnes (en bleu) et 1 onglet "récapitulatif" (en jaune)

dans chaque onglets bleus on voit les interventions effectuées (traduit par catégories "ITU", "ITS"...) et le temps passé

je souhaiterais additionner dans l'onglet "récap 1"

• le nombre d'interventions par catégorie et par personnes
• le nombre d'heures par catégorie et par personnes

j'ai commencé à le mettre manuellement pour les 3 premières personnes et en y mettant des couleurs pour se repérer mais je n'ai pas besoin des couleurs

dans un second temps je souhaiterais faire un nouvel onglet "récap 2" afin de récapituler par catégories, par personnes et par mois

merci d'avance de votre aide

cordialement

jmd6

Bonjour,

voici une solution avec 2 function perso,

Function AdditionOnglet(onglet As String, critere As String) As Double
Dim t As Double, sh, add1 As String, add2 As String, i As Integer
Set sh = Sheets(onglet)
  For i = 2 To 25 Step 2
    add1 = Range(Cells(8, i), Cells(161, i)).Address
    add2 = Range(Cells(8, i + 1), Cells(161, i + 1)).Address
    AdditionOnglet = AdditionOnglet + Application.SumIf(sh.Range(add1), critere, sh.Range(add2))
   Next i
End Function

Function NombreOnglet(onglet As String, critere As String) As Double
Dim t As Double, sh, add1 As String, i As Integer
Set sh = Sheets(onglet)
  For i = 2 To 25 Step 2
    add1 = Range(Cells(8, i), Cells(161, i)).Address
    NombreOnglet = NombreOnglet + Application.CountIf(sh.Range(add1), critere)
   Next i
End Function

merci

je vérifie et je vous tiens informé

merci bcp

jmd6

ah pardon, j'ai oublié, je les mets où les fonctions car je suis totalement novice en la matière ??

Bonjour,

le Function sont dans le fichier joint à mon précédent message, sur la page Module1

appuyer sur Alt+F11 pour ouvrir la fenêtre VBA

dans l'arborescence à gauche, sous le VBAProject (jmd6-Interv-Accomp 2017 Essai 1.xlsm)

a+

ah ok mais comment je les fais fonctionner ?

regarder les cellules du tableau sur l'onglet Recap 1

=NombreOnglet($B5;C$4)

et

=AdditionOnglet($B5;C$4)

super, c'est de la haute voltige pour moi

ça fonctionne super

je profite de ta présence pour te demander 1 autre service

la macro dans le Module 2 ne fonctionne pas tout à fait comme je le souhaite

la macro (dans l'onglet "recap 1) liste tous les onglets et moi je ne veux que les noms des personnes

comment je peux faire ?

merci d'avance

Bonjour,

rien à voir avec ta question mais si tu veux l'age et l'ancienneté exacts tenant compte du jour et du mois tu as :

=DATEDIF(U3;AUJOURDHUI();"y") 

eric

Bonjour,

Sub noms()
Dim sh
For i = 1 To Sheets.Count
 If Sheets(i).Name <> "Recap 1" And Sheets(i).Name <> "LEGENDES" Then Cells(i + 4, 2) = Sheets(i).Name
Next i
End Sub

un grand merci à tous les 2

je continue à améliorer mon fichier c'est super

encore merci et bonne soirée

je clique sur résolu

jmd6

Merci pour ce retour, au plaisir!

pour clôturer le fil, cliquer sur le bouton V vert du post à coté du bouton EDITER, merci!

Bonsoir à tous,

Une autre façon de procéder :

Option Explicit
Sub ventile()
Dim a, w(), i As Long, j As Long, dico As Object, ws As Worksheet
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    For Each ws In Worksheets
        If ws.Name <> "LEGENDES" And ws.Name <> "Recap 1" Then
            Set dico(ws.Name) = CreateObject("Scripting.Dictionary")
            dico(ws.Name).CompareMode = 1
            With ws.Range("a7").CurrentRegion
                For i = 2 To .Rows.Count
                    For j = 2 To .Columns.Count Step 2
                        If .Cells(i, j).Value <> "" Then
                            If Not dico(ws.Name).exists(.Cells(i, j).Value) Then
                                ReDim w(1 To 2)
                            Else
                                w = dico(ws.Name)(.Cells(i, j).Value)
                            End If
                            w(1) = w(1) + 1
                            w(2) = w(2) + .Cells(i, j + 1).Value
                            dico(ws.Name)(.Cells(i, j).Value) = w
                        End If
                    Next
                Next
            End With
        End If
    Next
    Application.ScreenUpdating = False
    With Sheets("Recap 1").[b4].CurrentRegion
        With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
            .ClearContents
        End With
        For i = 2 To .Rows.Count
            If dico.exists(.Cells(i, 1).Value) Then
                For j = 2 To .Columns.Count Step 2
                    If dico(.Cells(i, 1).Value).exists(.Cells(1, j).Value) Then
                        .Cells(i, j).Resize(, 2).Value = dico(.Cells(i, 1).Value)(.Cells(1, j).Value)
                    End If
                Next
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

klin89