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 Subklin89