Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копия сводной с формулами, Копирование сводной в виде значений с сохранением формул
 
#1
28.02.2016 16:41:03
Добрый день.
Кто-нибудь знает как можно скопировать сводную таблицу в значения (отвязать от исходных данных), но при этом сохранить формулы внутри таблицы.
Понятно, что такое только макросами.
Как отвязать от исходников я разобрался, а вот как формулы сохранить?
Даже не знаю от чего оттолкнуться, т.к. естественно структура сводной всегда разная.
 
 
 
#2
28.02.2016 16:57:09
Цитата
lis2109 написал: Кто-нибудь знает...
Судя по вашему примеру вы прошли мимо промежуточных итогов и консолидации - они очень похожи на вами желаемое.
И формул (как вам желательно) из сводной добыть "промблематично".
PS В "приемах" в разделе о сводных НВП задается вопросом -"Зачем нужна функция получить данные сводной таблицы?"... ;)
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
 
 
#3
28.02.2016 17:00:42
Когда-то делал код для сохранения стиля сводной. Добавил одну строку - формулы тоже сохраняются.
Применительно к Вашему файлу: надо создать еще одни лист после листа со сводной.
Перейти на лист сводной и запустить код. Все данные листа будут скопированы на второй лист, но уже не будет сводной - только таблица с такими же форматами и формулами.
Код
Sub Copy_Formats_And_PivotStyle()
    Dim oPvtTable As PivotTable
    Application.ScreenUpdating = False: Application.Calculation = xlManual
    With Sheets(2)
        ActiveSheet.UsedRange.Copy
        .Range(ActiveSheet.UsedRange.Address).PasteSpecial xlPasteValues
        .Range(ActiveSheet.UsedRange.Address).PasteSpecial xlPasteFormulas
        .Range(ActiveSheet.UsedRange.Address).PasteSpecial xlPasteFormats
        For Each oPvtTable In ActiveSheet.PivotTables
            Range(oPvtTable.TableRange1.Address).Copy
            .Range(oPvtTable.TableRange1.Address).PasteSpecial xlPasteValues
            .Range(oPvtTable.TableRange1.Address).PasteSpecial xlPasteFormulas
            .Range(oPvtTable.TableRange1.Address).PasteSpecial xlPasteFormats
        Next oPvtTable
    End With
    Application.Calculation = xlAutomatic: Application.ScreenUpdating = True
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#4
28.02.2016 17:21:49
Дмитрий, сводная копируется на второй лист, но почему-то остается тоже в виде сводной.
 
 
 
#5
28.02.2016 17:27:57
Да, уже заметил - если переносить формулы специальной вставкой - то они возвращают функционал сводной. Но в данном случае не поможет все равно - в Вашем примере надо не сохранять формулы - их надо создавать для итогов. А это уже несколько иное.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#6
28.02.2016 17:30:21
Натолкните на саму идею, по какому принципу можно воссоздавать формулы? За что зацепиться?
 
 
 
#7
28.02.2016 17:49:37
В общем не совсем все просто.
Первоначально надо определить строки итогов. Далее для каждого поля надо определить функцию: среднее, сумма, кол-во и т.д. И в зависимости от этого применять к итогам соответствующие формулы. СУММ для всех не подойдет - если для поля установлены Итого по - Среднее - то и формула должна будет быть вроде СРЗНАЧ.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#8
18.03.2016 11:06:30
А можно ли все сводные в книге (созданные автоматически например через "Отобразить страницы фильтра отчёта") преобразовать в значения с сохранением внешнего вида и на тех же листах, где были их источники-сводные. У меня есть такой записанно-исправленный макрос для 1 сводной...
Код
Sub ОТЧЁТ()

Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Application.Calculation = xlCalculationManual

   Selection.Copy
    Worksheets.Add.Name = "ОТЧЁТ"
    Sheets("ОТЧЁТ").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats
    Selection.WrapText = True
   
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = 1
Application.ScreenUpdating = 1

End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Читают тему
Наверх