Ярлыки

(16) 1С 8.3 (1) 2GIS (1) автоактивация (3) Активация (3) Андроид (113) Антивирус (2) Аудио (2) биоритмы (1) Блок питания (22) боль в спине (1) браузер (2) бросить курить (1) буквы соответствие (1) бумажник (1) бюджетирование (1) ВАЗ 2110 (1) вацап (1) видеонаблюдение (8) Видеосвязь (1) гаджет (1) Галстук (1) геокоординаты (1) дача (1) для дома (1) дом (2) драйвера (6) Дубликаты (1) еда (1) запись (1) Зарядка акб (1) Зарядное устройство (1) звук (4) здоровье (8) знаки зодиака (1) зрение (1) игнтернет (1) иероглифы (1) Изделия из дерева (1) Интернет (10) Интернет-магазины (3) Кино (1) ключница (1) Книги Журналы (1) кожаная обувь (4) командная строка (1) конвертор (1) кошелек (1) кресло-качалка (1) кухня (2) Лекарства (1) логика (1) макрос (1) медицина (1) мозги (1) морщины (2) мтс (1) музыка (9) мультики (1) Мыльные_пузыри (1) Натуральная кожа (56) Облако (1) омск (1) Он Лаин библиотеки (1) органайзер (1) оригами (1) Отбеливание (1) отслеживание посылок (1) Папка (1) Пароли (2) пароль (3) партмоне (1) парфюм (1) переименование файлов (1) питание (1) Планшет (5) поза сна (1) поздравление (1) поиск (1) поиск дублей (1) поисковик (1) Полезные сайты (1) портабле (2) принтер (4) Программы (58) простуда (1) расширения (1) редактор музыкальных файлов (1) Русский язык (1) рут (2) сеть (8) Скрыть информацию (1) Стиль (1) стихи (2) сумка (1) суставы (3) теги (1) трек-номер (1) тренинг (1) тренинг памяти (1) удаленный доступ (2) узлы (1) УНЧ (3) Управление компьютером (2) Управленческий учет (2) Успокоительные средства (1) фильмы (2) Флешка (53) фото (2) цвета в одежде (1) цена (1) экран не гаснет (1) эл почта (2) Ютуб (1) Access (10) Acronis True Image WD Edition (1) AliExpress (1) ALT-коды (1) audi (1) Avira Antivirus (1) bat (2) BIOS (4) chrom (15) Chrome (2) Cube iPlay 10 U83 (1) Dism++ (2) epson 1260 (1) ERD Commander (1) Excel (42) Faceter (1) Firefox (1) GHOST32 (4) gif анимация (1) Google (1) Google Hrome (1) Google Play (1) Grub4Dos (7) HDD (1) Honor (1) HP USB Disk Storage Tool (1) IPTV (1) KPI (1) Linux (16) NirCmd (1) office (4) PDF (1) Pinterest (1) portable (2) Prestigio3502 (1) Rufus (2) SSD (1) torrent (1) UEFI (1) VBA (42) WEB ресурсы (2) WiFi (2) Windows (77) Windows 10 (5) Windows 11 (2) Windows 7 (24) YouTube (15)

понедельник, 9 ноября 2015 г.

VBA и сводная таблица

[Excel (VBA) Сводные таблицы. Создание. Обновление. / Visual Basic / Sql.ru] хорошо, посмотри! http://www.sql.ru/forum/236836/excel-vba-svodnye-tablicy-sozdanie-obnovlenie

Sub SvodTable()
Dim i As Integer
Dim s As String

Sheets("Работы").Activate
Sheets("Работы").Unprotect
' определяю диапазон исходной таблицы  
ActiveSheet.Unprotect
ActiveSheet.Cells(2, 2).Select
  i = 2
      While ActiveSheet.Cells(i, 2).Formula <> ""
           i = i + 1
      Wend
'Range(Cells(2, 2), Cells(i - 1, 16)).Select
s = "Работы!" & Range(Cells(2, 2), Cells(i - 1, 16)).Address(ReferenceStyle:=xlR1C1)

' на основе диапазона строю сводную (в этой строке вылетает ошибка -Недопустимое имя сводной таблицы..)
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        s).CreatePivotTable TableDestination:="", TableName:= _
        "СводнаяТаблица1", DefaultVersion:=xlPivotTableVersion10

    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("СводнаяТаблица1").AddFields RowFields:=Array( _
        "ФИО сотрудника", "Наименование услуги", "Данные"), ColumnFields:="Месяц"
    With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("Итого, руб.")
        .Orientation = xlDataField
        .Caption = "Сумма по полю Итого, руб."
        .Position = 1
        .Function = xlSum
    End With
    With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("Итого, у.е.")
        .Orientation = xlDataField
        .Caption = "Сумма по полю Итого, у.е."
        .Function = xlSum
    End With
    ActiveWorkbook.ShowPivotTableFieldList = True
End Sub


Можно так.

Dim i As Long, strSource$ 
i = [a1].End(xlDown).row strSource = "'" & ActiveSheet.Name & "'!" & Range(Cells(1, 1), Cells(i, 3)).Address(ReferenceStyle:=xlR1C1)
Sheets.Add.Name = "Table1" ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _  
     strSource, VERSION:=xlPivotTableVersion15).CreatePivotTable _ 
     TableDestination:="Table1!R1C1", TableName:="СводнаяТаблица", _ DefaultVersion:=xlPivotTableVersion15

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

Sub CreatePivotTable()   
Dim PTCache As PivotCache
Dim PT As PivotTable
'  Создание  области  кэша    
Set PTCache = ActiveWorkbook.PivotCaches.Create( _
       SourceType:=xlDatabase, _ 
       SourceData:=Range("A1").CurrentRegion) 
'Добавление  нового  листа  в  сводную  таблицу    
Worksheets.Add 
Создание  сводной  таблицы    
Set PT = ActiveSheet.PivotTables.Add( _
       PivotCache:=PTCache, _
       TableDestination:=Range("A3")) 
Определение  полей    
With PT       
.PivotFields("Регион").Orientation = xlPageField       
.PivotFields("Месяц").Orientation = xlColumnField       
.PivotFields("Торговый  представитель") _          
             .Orientation = xlRowField       
.PivotFields("Продажи").Orientation = xlDataField       
'заголовки  полей  отсутствуют       
.DisplayFieldCaptions = False    
End With 
End Sub 

В данном случае процедура  CreatePivotTable  была упрощена (что облегчило ее  понимание) благодаря объявлению двух  переменных объекта:  PTCache  и  PT. Новый объект PivotCache  был создан с  помощью метода  Create. Также был добавлен рабочий лист, который стал  активным (на этом  листе размещается сводная таблица). Затем был создан объект  PivotTable  с  помощью метода  Add  из коллекции  PivotTables. В  последнем фрагменте кода добавляются поля в  сводную таблицу,  а  также задается их положение в  таблице путем присвоения значения свойству  Orientation. Обратите внимание  на  то, что исходный макрос  жестко  привязан  к  диапазону данных, на  основе которого  создается объект  PivotCache  ('Лист1!R1C1:R13C4'), и  к местоположению сводной таблицы (Лист2). В  процедуре  CreatePivotTable  сводная таблица основана на  текущем диапазоне, окружающем ячейку A1. Это гарантирует, что макрос будет выполняться даже тогда, когда в диапазон  добавлены дополнительные данные. Добавление рабочего  листа до  того, как была создана сводная таблица, исключает необходимость жесткого кодирования ссылки на  лист. Еще одно отличие заключается в  том, что написанный вручную  макрос  не  определяет  имя сводной таблицы. Да  это и  не  требуется, поскольку используется переменная объекта  PT, которая выполняет  эту задачу.

Комментариев нет:

Отправить комментарий