Страницы: 1
RSS
Сводные таблицы: фильтрация реестров по определенному признаку, с использованием VBA
 
Коллеги, Доброго времени суток.

У меня возник следующий вопрос и без Вашей помощи вряд ли я смогу в нем разобраться. Ситуация у меня следующая:
На работе, при обработке отчетов возникает необходимость пивотить реестры по определенному признаку, а затем делать копии получившихся таблиц и уже дальше с ними работать. И вот мне вся эта рутинная и запутанная работа надоела и я хочу попросить у Вас помощи в решении этого вопроса.

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

Выкладываю простой пример в файле, в котором отображена моя работа в этом плане и хочется попробовать довести это все до автоматизма
 
Цитата
obratka написал: ... из отчета 1) делать сводную таблицу, потом ее 2) фильтровать по нужным критериям и из каждого из них 3) делать отдельную копию на другом листе?
OFF Задача, в принципе, решаемая, но поскольку комплексная и без ваших наработок, то это "явный намек" на фриланс, однако, - раздел "Работа" платный... ;)  
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Здравствуйте. Все что вы описали можно сделать, даже Вам самостоятельно. Включите запись макроса и выполните описанные операции. После этого создайте кнопку и "повесьте" на него макрос. Записанный макрорекордером макрос будет работать с кучей ограничений о которых мы не знаем. Например имя листа должно быть всегда одинаковое, Диапазон данных не должен превышать диапазон при записи макроса, критерии всегда должны быть одинаковы или где их брать...... Чтобы все это учесть нужно знать все эти параметры, а у Вас нет своих наработок. По этой причине Вам и предложили другой раздел форума.
Но можно и по другому. В файле в котором уже созданы все нужные сводные таблицы менять исходные данные и достаточно обновить первую таблицу чтобы все остальные тоже обновились. Нужные критерии все равно придется выбирать или вписывать куда то руками. Попробуйте пока это, если появятся идеи с наработками, выкладывайте, помощь будет.
 
добрый день,вот код,переименовал лист на "Исходные_данные",иначе макрос не работает, кнопка в файл-примере на листе ("Исходные_данные").
Код
Sub CreatePivotTable1()
    Dim i%, pch As PivotCache, piv As PivotTable
    Application.ScreenUpdating = False
    With Sheets("Pivot")
    For Each piv In .PivotTables
      piv.TableRange2.Clear
    Next
    On Error Resume Next
    Application.DisplayAlerts = False
    On Error GoTo 0
    i = Sheets("Исходные_данные").Range("A2").End(xlDown).Row
   Set pch = ActiveWorkbook.PivotCaches.Create( _
   SourceType:=xlDatabase, _
   SourceData:="Исходные_данные!A2:D" & i)
     Set piv = .PivotTables.Add(PivotCache:=pch, _
     TableDestination:=.Range("A3"))
   End With
  With piv
    .PivotFields("Сумма на начало") _
     .Orientation = xlDataField
     .PivotFields("Сумма на конец") _
     .Orientation = xlDataField
     .PivotFields("Страна") _
     .Orientation = xlPageField
    .PivotFields("Код_компании") _
        .Orientation = xlRowField
        .TableStyle2 = "PivotStyleMedium8"
        .NullString = "0"
    End With
  Application.ScreenUpdating = True
End Sub

добавлю,что отчет по отдельным странам сделаю после обеда,попозже,-это макросом просто сделать,сейчас нет времени(я на работе).
 
obratka,вот макросы создания отчета по предложенным Вами четырем странам,при повторе добавленные макросом листы удалите
Код
Sub CreatePivotTable2()
    Dim i%, pch As PivotCache, piv As PivotTable
    Application.ScreenUpdating = False
    With Sheets("Pivot")
    For Each piv In .PivotTables
      piv.TableRange2.Clear
    Next
    On Error Resume Next
    Application.DisplayAlerts = False
    On Error GoTo 0
    i = Sheets("Исходные_данные").Range("A2").End(xlDown).Row
   Set pch = ActiveWorkbook.PivotCaches.Create( _
   SourceType:=xlDatabase, _
   SourceData:="Исходные_данные!A2:D" & i)
     Set piv = .PivotTables.Add(PivotCache:=pch, _
     TableDestination:=.Range("A3"))
   End With
  With piv
    .PivotFields("Сумма на начало") _
     .Orientation = xlDataField
     .PivotFields("Сумма на конец") _
     .Orientation = xlDataField
     
    .PivotFields("Страна") _
        .Orientation = xlRowField
        .TableStyle2 = "PivotStyleMedium8"
        .NullString = "0"
    End With
  Application.ScreenUpdating = True
End Sub
Su
Код
Sub отчет()
    Dim i%, i1%
    i1 = Range("B" & Cells.Rows.Count).End(xlUp).Row - 1
For i = 5 To i1
   Sheets("Pivot").Range("B" & i).ShowDetail = True
   Next
End Sub
Изменено: sv2013 - 08.11.2015 14:28:39 (отменил редактирование)
 
sv2013, Спасибо огромное. Буду ждать, а пока что попытаюсь понять Ваш код.
 
добавлю,вот итоговый файл-пример
 
obratka,поясню,в последнем файл-примере( example_9_11_2015_1) макрос CriatePivotTable2 и макрос отчет( и нежеуказанная версия) обрабатывает любое число стран и добавляет соответствующее число листов,
в предыдущем файл-примере( example_8_11_2015_ ,макрос CriatePivotTable1 и другой  макрос отчет, записан макрорекодером,этот макрос Вы можете легко доработать или записать сами аналогичный.Успехов Вам.

Код
Sub отчет()
    Dim i%, i1%
  With Sheets("Pivot")
    i1 = .Range("B" & Cells.Rows.Count).End(xlUp).Row - 1
   For i = 5 To i1
    .Range("B" & i).ShowDetail = True
   Next
   End With
End Sub
Страницы: 1
Наверх