Totaux par nature

Bonjour,

je souhaite obtenir un tableau qui totalise les activités par site puis par code, nature et période (matin /après midi). un fichier est joint.

quelqu'un peut-il m'aider?

Merci

Bonjour

est ce qu'un simple TCD ne répond à ta demande ?

regarde et dis-nus !

CORDIA5

Bonjour,

je pense que vos données sont bien pour un Tableau croisé dynamique,

voici l'exemple:

Bonjour le Fil et le Forum !

Une proposition avec la fonction SOMMEPROD.

la solution avec sommeprod de JFL correspond davantage à ce que je cherche.

Merci à corbias et sabv pour les propositions tcd

Bonsoir à tous,

Comme j'aime me compliquer la vie

Le tableau est restitué dans son ensemble, à côté du tableau source

Supprime la ligne 1, celle de tes annotations

Attention aux espaces supperflus

Option Explicit
Sub test()
Dim a, b(), e, i As Long, j As Long, n As Long, t As Long
Dim dico As Object, dico1 As Object, dico2 As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    Set dico1 = CreateObject("Scripting.Dictionary")
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.CompareMode = 1
    For Each e In Array("matin", "apres midi", "demi journées")
        dico(e) = dico.Count
    Next
    With Sheets("Feuil1").Range("a1").CurrentRegion
        a = .Value: ReDim b(1 To ((UBound(a, 1) - 1) * 3) + 1, 1 To 3)
        b(1, 1) = a(1, 4): b(1, 2) = "----": n = 1: t = 2
        For i = 2 To UBound(a, 1)
            If Not dico1.exists(a(i, 1)) Then
                t = t + 1
                dico1(a(i, 1)) = t
                If UBound(b, 2) < t Then
                    ReDim Preserve b(1 To UBound(b, 1), 1 To UBound(b, 2) + 10)
                End If
                b(1, t) = a(i, 1)
            End If
            If Not dico2.exists(a(i, 4)) Then
                If n = 1 Then n = n + 1 Else n = n + 3
                dico2(a(i, 4)) = n
                b(n, 1) = a(i, 4)
                b(n, 2) = dico.keys()(0)
                b(n + 1, 2) = dico.keys()(1)
                b(n + 2, 2) = dico.keys()(2)
            End If
            b(dico2(a(i, 4)) + dico(a(i, 3)), dico1(a(i, 1))) = b(dico2(a(i, 4)) + dico(a(i, 3)), dico1(a(i, 1))) + 1
        Next
        For i = 2 To UBound(b, 1) Step dico.Count '3
            For j = 3 To UBound(b, 2)
                b(i + 2, j) = _
                Application.Sum(Application.Index(b, Evaluate("row(" & i & ":" & i + 1 & ")"), j))
            Next
        Next
        Application.ScreenUpdating = False
        With .Offset(, .Columns.Count + 1).Resize(n + 2, t)
            .CurrentRegion.Clear: .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .HorizontalAlignment = xlCenter
                .Font.Bold = True
                .Cells(1).Resize(, 2).Interior.ColorIndex = 15
                With .Offset(, 2).Resize(, .Columns.Count - 2)
                    .Interior.ColorIndex = 40
                End With
            End With
            With .Columns(1)
                With .Offset(1).Resize(.Rows.Count - 1)
                    .Resize(, 2).HorizontalAlignment = xlCenter
                    .Interior.ColorIndex = 40
                End With
            End With
            For i = 2 To .Rows.Count Step 3
                With .Rows(i)
                    .Resize(3).BorderAround Weight:=xlThin
                    With .Offset(2, 1).Resize(1, .Columns.Count - 1)
                        .BorderAround Weight:=xlThin
                        .Interior.ColorIndex = 19
                    End With
                End With
            Next
        End With
        Set dico = Nothing: Set dico1 = Nothing: Set dico2 = Nothing
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Rechercher des sujets similaires à "totaux nature"