Excel VBA:Вывод различных значений и промежуточных итогов

StackOverflow https://stackoverflow.com/questions/1603414

Вопрос

У меня есть данные такой формы:

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

Порядок сортировки отсутствует.Категории неизвестны во время компиляции.Я хочу, чтобы макрос VBA циклически перебирал диапазон и выводил список различных значений с промежуточными итогами для каждого.Для приведенных выше данных это будет выглядеть так:

Category      Total Amount
Dues          $224
Donations     $55

Как я могу это сделать?Кроме того, есть ли способ заставить макрос запускаться каждый раз при обновлении приведенной выше таблицы или пользователю необходимо нажимать кнопку?

Это было полезно?

Решение

Для этого вы можете использовать встроенную функцию Excel.Цикл может занять много времени и быть проблематичным, если у вас есть много значений, которые нужно пройти.

Что-то вроде следующего может помочь вам начать создание сводной таблицы (из 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

Это для промежуточных итогов (хотя я предпочитаю сводные таблицы)http://msdn.microsoft.com/en-us/library/aa213577(office.11).aspx


РЕДАКТИРОВАТЬ:Перечитал и возникли следующие мысли.Настройте сводную таблицу на отдельном листе (без использования какого-либо кода), затем поместите следующий код на лист, на котором есть сводная таблица, чтобы таблица обновлялась каждый раз при выборе листа.

    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

Редактировать #2 обновить все шарнирные таблицы на листе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

По ссылке есть несколько вариантов обновления сводных таблиц на листе/книге.

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top