Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос для нескольких сводных таблиц на одном листе
 
Добрый день. На одном листе необходимо разместить несколько сводных макросом:
Код
Sub ддд()
Dim lr1& 
   ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Лист1!R9C1:R2000C25", Version:=xlPivotTableVersion15).CreatePivotTable _
        TableDestination:="Лист2!R1C1", TableName:="СводнаяТаблица1", _
        DefaultVersion:=xlPivotTableVersion15
     With ActiveSheet.PivotTables("СводнаяТаблица1")
        .PivotFields( _"группа")
        .Orientation = xlRowField        
         .Position = 1
    End With
    With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields( _"степень") 
       .Orientation = xlRowField  
       .Position = 2  
  End With    
       ActiveSheet.PivotTables("СводнаяТаблица1").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица1").PivotFields("размер"), _ 
         "Количество по полю размер", xlCount  
         lr1 = Cells(Rows.Count, 1).End(xlUp).Row + 1
       ActiveWorkbook.Worksheets("Лист2").PivotTables("СводнаяТаблица1").PivotCache. _
        CreatePivotTable TableDestination:=Worksheets("Лист2").Cells(lr1 + 1, 1), TableName:= _
        "СводнаяТаблица2", DefaultVersion:=xlPivotTableVersion15

 With ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields("канал")
        .Orientation = xlRowField    
        .Position = 1  
      End With  
   With ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields("вид") 
       .Orientation = xlRowField    
        .Position = 2    End With  
  ActiveSheet.PivotTables("СводнаяТаблица2").AddDataField ActiveSheet.PivotTables _ 
       ("СводнаяТаблица2").PivotFields("Совокупный"), _ 
       "Количество по полю Совокупный", xlCountEnd Sub

Вот только количество строк с результатами всегда будут разное, то есть первая таблица выйдет за пределы 34 строки. Может подскажете как разместить вторую сводную  после результатов первой и указать этот адрес в TableDestination:="Лист2!R35C1" ?

Изменено: evgen032 - 13 Мар 2017 16:19:02
 
evgen032, код следует оформлять соответствующим тегом. Не первый ведь день на форуме - видели, как он выглядит у других? И не вижу смысла писать его через строку.
Ищите такую кнопку и исправьте своё сообщение.
Тег VBA.jpg (19.2 КБ)
 
Переход на пустую ячейку оформил:
Код
Dim lr1&
lr1 = Cells(Rows.Count, 1).End(xlUp).Row + 1

ActiveCell.Offset(lr1, 0)


А вот как решить TableDestination:="Лист2!R35C1" ?
 
Может кому понадобится: Рабочий код в первом сообщении (поправил) . Можно по аналогии добавлять сводные, в моем случае выдает данные по 14 ти .
Есть ли способ автоматического определения версии офиса и подстановки результата в  DefaultVersion:=xlPivotTableVersion15? Не хочется отдельные кнопки делать.
Страницы: 1
Читают тему (гостей: 1)
Наверх