Excel VBA: Saída Valores distintos e Subtotais

Question

Eu tenho dados desta forma:

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

Não há ordem de classificação. As categorias são desconhecidas no momento da compilação. Eu quero uma macro VBA para percorrer o intervalo, a saída de uma lista de valores distintos, com os subtotais para cada um. Para os dados acima, ele ficaria assim:

Category      Total Amount
Dues          $224
Donations     $55

Como posso fazer isso? Além disso, existe uma maneira de fazer a macro executar cada vez que a tabela acima é atualizado, ou é necessário para que o usuário clique em um botão?

Answer 1

Você pode querer usar um construído em função de Excel para fazer isso. Looping pode levar um longo tempo e ser problemático se você tem um monte de valores para percorrer.

Algo como o seguinte pode ajudar a começar na criação de uma tabela dinâmica (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

Isto é para subtotais (embora eu prefiro muito mais tabelas dinâmicas) http://msdn.microsoft.com/en-us /library/aa213577(office.11).aspx

---

EDIT: Reli e têm os seguintes pensamentos. Defina-se a tabela de pivô numa folha separada (sem o uso de qualquer código), em seguida, colocar o código seguinte na folha que tem a tabela de pivô de modo que a mesa irá actualizar toda a folha é seleccionado.

    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 Atualizar todas as tabelas dinâmicas na folha 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

O link tem várias opções sobre como atualizar tabelas dinâmicas na folha / pasta de trabalho.