Excel VBA: Valeurs et sous-totaux distincts en sortie

Question

J'ai des données de cette forme:

Category      Source      Amount
Dues          FTW         $100
Donations     ODP         $20
Donations     IOI         $33
Dues          MMK         $124

Il n'y a pas d'ordre de tri. Les catégories sont inconnues au moment de la compilation. Je souhaite qu'une macro VBA parcourt la plage, génère une liste de valeurs distinctes, avec les sous-totaux pour chacune. Pour les données ci-dessus, cela ressemblerait à ceci:

Category      Total Amount
Dues          $224
Donations     $55

Comment puis-je faire cela? De même, existe-t-il un moyen d’exécuter la macro à chaque mise à jour du tableau ci-dessus ou faut-il que l’utilisateur clique sur un bouton?

Answer 1

Vous pouvez utiliser une fonctionnalité Excel intégrée pour le faire. La mise en boucle peut prendre beaucoup de temps et poser problème si vous avez beaucoup de valeurs à parcourir.

Quelque chose comme ce qui suit pourrait vous aider à créer un tableau croisé dynamique (tiré de http: //www.ozgrid.com/News/pivot-tables.htm )

Sub MakeTable()
Dim Pt As PivotTable
Dim strField As String

    'Pass heading to a String variable
    strField = Selection.Cells(1, 1).Text

    'Name the list range
    Range(Selection, Selection.End(xlDown)).Name = "Items"

    'Create the Pivot Table based off our named list range.
    'TableDestination:="" will force it onto a new sheet
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
        SourceData:="=Items").CreatePivotTable TableDestination:="", _
            TableName:="ItemList"

    'Set a Pivot Table variable to our new Pivot Table
    Set Pt = ActiveSheet.PivotTables("ItemList")

    'Place the Pivot Table to Start from A3 on the new sheet
    ActiveSheet.PivotTableWizard TableDestination:=Cells(3, 1)

    'Move the list heading to the Row Field
    Pt.AddFields RowFields:=strField
    'Move the list heading to the Data Field
    Pt.PivotFields(strField).Orientation = xlDataField
End Sub

Ceci concerne les sous-totaux (bien que je préfère de loin les tableaux croisés dynamiques) http://msdn.microsoft.com/en-us /library/aa213577(office.11).aspx

EDIT: Je relis et ai les pensées suivantes. Configurez le tableau croisé dynamique sur une feuille distincte (sans utiliser de code), puis placez le code suivant sur la feuille contenant le tableau croisé dynamique afin que le tableau soit mis à jour à chaque fois que la feuille est sélectionnée.

    Private Sub Worksheet_Activate()

    Dim pt As PivotTable

        'change "MiPivot" to the name of your pivot table
        Set pt = ActiveSheet.PivotTables("MyPivot")

        pt.RefreshTable

    End Sub

Modifier n ° 2 Actualiser tous les tableaux croisés dynamiques sur la feuille http://www.ozgrid.com/VBA/pivot-table-refresh. htm

Private Sub Worksheet_Activate()    
    Dim pt As PivotTable

    For Each pt In ActiveSheet.PivotTables
        pt.RefreshTable
    Next pt
End Sub

Le lien propose plusieurs options pour actualiser les tableaux croisés dynamiques de la feuille / du classeur.