Excel VBA: Output Distinct Values and Subtotals

问题

I have data of this form:

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

There is no sort order. The categories are unknown at compile time. I want a VBA macro to cycle through the range, output a list of distinct values, with the subtotals for each. For the above data, it would look like this:

Category      Total Amount
Dues          $224
Donations     $55

How can I do this? Also, is there a way to make the macro run every time the table above is updated, or is it necessary for the user to click a button?

回答1:

You may want to use a built in Excel feature to do this. Looping can take a long time and be problematic if you have a lot of values to loop through.

Something like the following might get you started on creating a pivot table (from 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

This is for subtotals (though I much prefer pivot tables) http://msdn.microsoft.com/en-us/library/aa213577(office.11).aspx

EDIT: I reread and have the following thoughts. Set up the pivot table on a separate sheet (without using any code) then put the following code on the sheet that has the pivot table so that the table will update everytime the sheet is selected.

    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

Edit #2 Refresh all pivot tables on sheet 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

The link has multiple options on how to refresh pivot tables in the sheet/workbook.

来源：https://stackoverflow.com/questions/1603414/excel-vba-output-distinct-values-and-subtotals

标签

excel

vba

excel-vba

distinct-values