Lijst weergeven met totalen en percentages achter van totaal

[globe]

Wekelijks gebruik ik een lijst waar ik een uur handmatig formules in zit te knippen en plakken.

Uit mijn systeem kan ik een voorraadlijst of verkooplijst draaien met de totale aantallen.

een voorbeeld in bijgevoegde excel tabblad 'info'.

Hier wil ik per artikel het totaal aan toevoegen (doe ik nu met subtotaal, excel kopieren en plakken speciaal)
Hierachter wil ik het percentage per maat van het toaal hebben.

Een voorbeeld hiervan in tabblad 'uitkomst'.

Zou dit mogelijk zijn?

 

[VenA]

Probeer het eens met een draaitabel.

 

[globe]

Bedankt voor het antwoord, dat gaat helaas niet werken. Er staan achter kolom A-C nog veel meer kolommen die intact moeten blijven.

Het moet redelijk idiot-proof zijn.

 

[VenA]

Je kan de draaitabel ook in een ander blad zetten!

 

[HSV]

Of je maakt er een code voor, het is immers de Vba sectie waar de vraag in staat.

Sub hsv()
Dim sn, i As Long, n As Long, area As Range, tb As Range, rr As Range, cl As Range
With Sheets("info")
sn = .Cells(1).CurrentRegion
 ReDim arr(3, UBound(sn))
   For i = 2 To UBound(sn)
     
        ReDim Preserve arr(3, n + 2)
             arr(0, n) = sn(i, 1)
             arr(1, n) = sn(i, 2)
             arr(2, n) = sn(i, 3)
         If sn(i, 1) <> sn(i + IIf(i = UBound(sn), 0, 1), 1) Then
           n = n + 1
             arr(0, n) = ""
             arr(1, n) = ""
             arr(2, n) = ""
       End If
  n = n + 1
 Next i
 End With
 
    With Sheets("uitkomst")
       .Cells(1).CurrentRegion.ClearContents
       .Cells(1).Resize(, 4) = Array(sn(1, 1), sn(1, 2), sn(1, 3), "percentage")
       .Cells(2, 1).Resize(n, 4) = Application.Transpose(arr)
          For Each area In .Columns(3).SpecialCells(2).Areas
            Set tb = area
            Set rr = tb.Cells(tb.Rows.Count)
            rr.Offset(1) = "=sum(" & tb.Address & ")"
               For Each cl In tb
                 If cl.Row <> 1 Then cl.Offset(, 1) = "=" & cl.Address & "/" & rr.Offset(1)
               Next cl
           Next area
   End With
End Sub

 

[VenA]

Mits de versie hoger is dan Xl-2007 en omdat we in de VBA sectie zitten een paar regels code.:d

Private Sub Worksheet_Activate()
For Each pt In ActiveSheet.PivotTables
    pt.RefreshTable
Next pt
End Sub

 

[HSV]

@VenA, Je code werkt ook in Excel 2007.

Een paar regeltjes minder is ook genoeg.

Private Sub Worksheet_Activate()
 ThisWorkbook.RefreshAll
End Sub

 

[VenA]

@HSV, Google en ThisForum are my best friends

Volgens mij werkt het groeperen zoals toegepast niet in XL-2007. Laat de TS maar aangeven wat hij/zij de beste 'idiot-proof' oplossinging vindt.

 

[HSV]

Ik heb weinig verstand van pivottables en groeperen (al zit die optie er wel op in Excel 2007).

Toch nog een minpuntje in je pivot; Je percentages kloppen helaas niet.

 

[VenA]

Zowel in #6 als #8 aangeven dat het niet werkt in Xl-2007. Wel een beetje de boel up to date houden.:d

 

[HSV]

Leve de vooruitgang.