Мир MS Excel - Создание сводных таблиц макросом

Вход

Регистрация

Напомнить пароль

= Мир MS Excel/Создание сводных таблиц макросом

Вставьте этот код:

Sub CreatePT()

Dim Pt As PivotTable
Dim strField As String

    strField = Selection.Cells(1, 1).Text
    Range(Selection, Selection.End(xlDown)).Name = "Items"

    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
        SourceData:="=Items").CreatePivotTable TableDestination:="", _
            TableName:="ItemList"

    Set Pt = ActiveSheet.PivotTables("ItemList")
    ActiveSheet.PivotTableWizard TableDestination:=Cells(3, 1)
    Pt.AddFields RowFields:=strField
    Pt.PivotFields(strField).Orientation = xlDataField

    End Sub

в стандартный модуль. Выделите заголовок исходных данных и запустите макрос.
Сводная таблица готова.