Skip to content
На чтение 2 мин. Просмотров 8.6k.
Что делает макрос: Это не редкость, когда имеется несколько сводных таблиц в одной книге. Чаще всего эти сводные таблицы ссылаются на данные, которые требует их обновления. Этот макрос поможет обновить все сводные таблицы по первому требованию.
Содержание
- Что делает макрос
- Код макроса
- Как этот код работает
- Как использовать
Что делает макрос
Этот макрос — перебирает рабочие листы, а затем перебирает сводные таблицы. На каждом цикле, макрос обновляет сводную таблицу.
Код макроса
Sub ObnovitSvodnieTablici() 'Шаг 1: Объявляем переменные Dim ws As Worksheet Dim pt As PivotTable 'Шаг 2: Запускаем цикл через каждый лист книги For Each ws In ThisWorkbook.Worksheets 'Шаг 3: Запускаем цикл через все сводные таблицы For Each pt In ws.PivotTables pt.RefreshTable Next pt Next ws End Sub
Как этот код работает
- Шаг 1 первый объявляет объект под названием WS. Это создает контейнер памяти для каждого рабочего листа. Он также объявляет объект под названием PT, который держит
каждую сводную таблицу. - Шаг 2 просматривает все рабочие листы в этой книге. Обратите внимание, что мы используем ThisWorkbook вместо ActiveWorkbook.
- Шаг 3 цикл проходит через все сводные таблицы в каждом листе, а затем запускает RefreshTable метод. После макрос переходит к следующему листу. После того, как все листы были
оценены, макрос заканчивается. ActiveWorkbook относится к книге, которая в данный момент активна.
В качестве альтернативного метода для обновления всех сводных таблиц в книге, вы можете использовать ThisWorkbook.RefreshAll. Это обновляет все сводные таблицы в рабочей книге. Тем не менее, он также обновляет все таблицы запросов. Так что, если у вас есть таблицы данных, которые подключены к внешнему источнику или в Интернете, на них будет влиять метод RefreshAll. Если это не является проблемой, вы можете просто ввести ThisWorkbook.RefreshAll в стандартный модуль.
Как использовать
Для реализации этого макроса, вы можете скопировать и вставить его в стандартный модуль:
- Активируйте редактор Visual Basic, нажав ALT + F11.
- Щелкните правой кнопкой мыши имя проекта / рабочей книги в окне проекта.
- Выберите Insert➜Module.
- Введите или вставьте код.
Even we can refresh particular connection and in turn it will refresh all the pivots linked to it.
For this code I have created slicer from table present in Excel:
Sub UpdateConnection()
Dim ServerName As String
Dim ServerNameRaw As String
Dim CubeName As String
Dim CubeNameRaw As String
Dim ConnectionString As String
ServerNameRaw = ActiveWorkbook.SlicerCaches("Slicer_ServerName").VisibleSlicerItemsList(1)
ServerName = Replace(Split(ServerNameRaw, "[")(3), "]", "")
CubeNameRaw = ActiveWorkbook.SlicerCaches("Slicer_CubeName").VisibleSlicerItemsList(1)
CubeName = Replace(Split(CubeNameRaw, "[")(3), "]", "")
If CubeName = "All" Or ServerName = "All" Then
MsgBox "Please Select One Cube and Server Name", vbOKOnly, "Slicer Info"
Else
ConnectionString = GetConnectionString(ServerName, CubeName)
UpdateAllQueryTableConnections ConnectionString, CubeName
End If
End Sub
Function GetConnectionString(ServerName As String, CubeName As String)
Dim result As String
result = "OLEDB;Provider=MSOLAP.5;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error;Update Isolation Level=2"
'"OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False"
GetConnectionString = result
End Function
Function GetConnectionString(ServerName As String, CubeName As String)
Dim result As String
result = "OLEDB;Provider=MSOLAP.5;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error;Update Isolation Level=2"
GetConnectionString = result
End Function
Sub UpdateAllQueryTableConnections(ConnectionString As String, CubeName As String)
Dim cn As WorkbookConnection
Dim oledbCn As OLEDBConnection
Dim Count As Integer, i As Integer
Dim DBName As String
DBName = "Initial Catalog=" + CubeName
Count = 0
For Each cn In ThisWorkbook.Connections
If cn.Name = "ThisWorkbookDataModel" Then
Exit For
End If
oTmp = Split(cn.OLEDBConnection.Connection, ";")
For i = 0 To UBound(oTmp) - 1
If InStr(1, oTmp(i), DBName, vbTextCompare) = 1 Then
Set oledbCn = cn.OLEDBConnection
oledbCn.SavePassword = True
oledbCn.Connection = ConnectionString
oledbCn.Refresh
Count = Count + 1
End If
Next
Next
If Count = 0 Then
MsgBox "Nothing to update", vbOKOnly, "Update Connection"
ElseIf Count > 0 Then
MsgBox "Update & Refresh Connection Successfully", vbOKOnly, "Update Connection"
End If
End Sub
Even we can refresh particular connection and in turn it will refresh all the pivots linked to it.
For this code I have created slicer from table present in Excel:
Sub UpdateConnection()
Dim ServerName As String
Dim ServerNameRaw As String
Dim CubeName As String
Dim CubeNameRaw As String
Dim ConnectionString As String
ServerNameRaw = ActiveWorkbook.SlicerCaches("Slicer_ServerName").VisibleSlicerItemsList(1)
ServerName = Replace(Split(ServerNameRaw, "[")(3), "]", "")
CubeNameRaw = ActiveWorkbook.SlicerCaches("Slicer_CubeName").VisibleSlicerItemsList(1)
CubeName = Replace(Split(CubeNameRaw, "[")(3), "]", "")
If CubeName = "All" Or ServerName = "All" Then
MsgBox "Please Select One Cube and Server Name", vbOKOnly, "Slicer Info"
Else
ConnectionString = GetConnectionString(ServerName, CubeName)
UpdateAllQueryTableConnections ConnectionString, CubeName
End If
End Sub
Function GetConnectionString(ServerName As String, CubeName As String)
Dim result As String
result = "OLEDB;Provider=MSOLAP.5;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error;Update Isolation Level=2"
'"OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False"
GetConnectionString = result
End Function
Function GetConnectionString(ServerName As String, CubeName As String)
Dim result As String
result = "OLEDB;Provider=MSOLAP.5;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error;Update Isolation Level=2"
GetConnectionString = result
End Function
Sub UpdateAllQueryTableConnections(ConnectionString As String, CubeName As String)
Dim cn As WorkbookConnection
Dim oledbCn As OLEDBConnection
Dim Count As Integer, i As Integer
Dim DBName As String
DBName = "Initial Catalog=" + CubeName
Count = 0
For Each cn In ThisWorkbook.Connections
If cn.Name = "ThisWorkbookDataModel" Then
Exit For
End If
oTmp = Split(cn.OLEDBConnection.Connection, ";")
For i = 0 To UBound(oTmp) - 1
If InStr(1, oTmp(i), DBName, vbTextCompare) = 1 Then
Set oledbCn = cn.OLEDBConnection
oledbCn.SavePassword = True
oledbCn.Connection = ConnectionString
oledbCn.Refresh
Count = Count + 1
End If
Next
Next
If Count = 0 Then
MsgBox "Nothing to update", vbOKOnly, "Update Connection"
ElseIf Count > 0 Then
MsgBox "Update & Refresh Connection Successfully", vbOKOnly, "Update Connection"
End If
End Sub
Макрос для настройки полей и форматирования сводной таблицы
В данном примере представлены исходные коды и описания для макросов, которые позволяют настраивать и форматировать любые сводные таблицы.
Макрос для обновления сводной таблицы в Excel
Для примера воспользуемся тестовой сводной таблицей из предыдущего примера: Макрос для создания сводной таблицы в Excel.
Данной сводной таблице уже присвоено внутреннее имя «ТаблицаМ» (как описано в предыдущем примере, перейдите по ссылке выше картинки). Каждая сводная таблица состоит из 4-ох видов полей:
- Поля ФИЛЬТРЫ.
- Поля СТРОКИ.
- Поля КОЛОННЫ.
- Поля ЗНАЧЕНИЯ.
Поля фильтров содержат ту часть таблицы исходных данных, которые необходимо проанализировать уже в сводной таблице. В примере следует проанализировать объем оборотов по отдельным магазинам фирмы. Как поле колон, так и поле строк определяет соответственно ту часть исходных данных, которую необходимо сортировать по строкам или по столбцам. Нет здесь определенного правила – все зависит от желаемого результата, который необходимо получить.
В данном примере определено:
- Столбец в исходных данных «Год» – находиться в поле фильтров.
- «Месяц» – определен как поле строк.
- «Магазины» – подчиненный к полю колон.
- «Оборот» – это поле значений, соответственно.
Далее рассмотрим, как изменять значения полей сводной таблицы с помощью макроса.
С помощью блока опций для второго конструктора With собираем расположение полей в сводной таблице. Текущие настройки полей при создании сводной таблицы определяются следующими строками кода макроса:
With ActiveSheet.PivotTables(«ТаблицаМ»)
.SmallGrid = True
.PivotFields(«Оборот»).Orientation = xlDataField
.PivotFields(«Год»).Orientation = xlPageField
.PivotFields(«Месяц»).Orientation = xlRowField
.PivotFields(«Магазины»).Orientation = xlColumnField
End With
Как видно из структуры данной части кода, каждое с полей сводной таблицы определяется отдельной строкой макроса. Ведь эта часть кода находиться внутри конструктора, который начинается с инструкции With. Если бы мы не использовали конструктор, тогда эти свойства и методы необходимо было бы каждый раз добавлять к объекту:
ActiveSheer.PivotTables(„ТаблицаМ”)
Примечание. «ТаблицаМ» – это внутреннее имя таблицы, которое было ей присвоено при создании для того, чтобы на нее было легче ссылаться в том числе и в коде макроса.
И к такому объекту должно относиться каждое поле настраивая порядок полей для сводной таблицы.
Заголовки столбцов, которые необходимо упорядочить определенным полем указываем (в скобках) как аргумент в методе PivotFields перед его свойством Orientation. В конце строки указываем параметром, какое поле было определено. Для этого к распоряжению язык VBA предоставляет нам выше упоминаемые 4 типа полей:
Поля | Код VBA |
ФИЛЬТРЫ | xlPageField |
СТРОКИ | xlRowField |
КОЛОННЫ | xlColumnField |
ЗНАЧЕНИЯ | xlDataField |
С помощью этих 4 строк VBA-кода макроса можно полностью изменить и по-другому настроить сводную таблицу. Разные настройки полей можно генерировать простейшими макросами, благодаря чему можно моментально перенастроить структуру любой сводной таблицы. Так даже намного удобнее, чем вручную перетягивать мышкой поля на уровне пользовательского интерфейса для настройки сводной таблицы в Excel.
Создадим макрос для изменения и настройки полей сводной таблицы. Откройте редактор макросов (ALT+F11) и создайте модуль если он еще не создан: «Insert»-«Module».
Введете код макроса, в результате которого будет выполнена автоматическая перенастройка структуры сводной таблицы с помощью изменения расположения полей для заголовков исходной таблицы «Магазины» и «Год»:
Sub ChangeTableM()
With ActiveSheet.PivotTables("ТаблицаМ")
.PivotFields("Магазины").Orientation = xlPageField
.PivotFields("Год").Orientation = xlColumnField
End With
End Sub
Чтобы запустить макрос нажмите комбинацию горячих клавиш (ALT+F8) или выберите инструмент: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«ChangeTableM» и нажмите на кнопку «Выполнить».
В результате сводная таблица автоматически изменит свою структуру как показано на рисунке.
Обратите внимание! В первой версии структуры сводной таблицы поле страницы служило для выбора года, относительного к соответственным показателям оборота магазинов фирмы. А теперь поле страниц служит для выбора соответственного магазина фирмы. В то же время года находятся в заголовках столбцов (поле КОЛОННЫ).
Форматирование сводной таблицы макросом
Созданная по умолчанию сводная таблица в большинстве случаев не соответствует желаемому уровню читабельности для пользователей. Как минимум нужно ей задать все необходимые форматы для отображения числовых значений. Следующий код макроса позволяет автоматически присвоить желаемый стиль для отображения чисел в денежном формате:
Sub FormatDeneg()
ActiveSheet.PivotTables("ТаблицаМ").PivotFields("Сумма по полю Оборот").NumberFormat = "# ##0 " & ChrW(8381)
End Sub
Снова нажмите комбинацию горячих клавиш (ALT+F8) или выберите: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«FormatDeneg» и нажмите «Выполнить».
Данный код необходимо записать в тот же самый модуль, в котором находятся коды других макросов.
В результате действия этого короткого и простого макроса все числовые значения в таблице будут преобразованы в денежный формат рублей (с разделителем тысяч и без копеек). Запустив макрос «FormatDeneg» сводная, таблица приобретет следующий вид:
В коде макроса мы использовали свойство NumberFormat, которое играет главную роль в форматировании чисел. В параметрах свойства мы просто указываем тип формат для отображения значения. Разновидность типов можно взять из списка: «ГЛАВНАЯ»-«Ячейки»-«Формат»-«Формат ячеек» (CTRL+1).
В появившемся окне на закладке «Число» выберите опцию «(все форматы)» из списка «Числовые форматы:». В правом поле «Тип:» можно подобрать свой желаемый параметр для свойства NumberFormat.
Обратите внимание! В конце строки параметра мы с помощью символа амперсанта добавляем непечатный символ, который возвращает функция ChrW(8381). Данная функция позволяет там вводить непечатные символы Unicode. А код 8381 в ее аргументе – это юникод непечатного символа рубля ₽
Подобными способами можно форматировать всю сводную таблицу используя другие сроки кода макроса. Просто нужно менять параметры для свойств (присваивать толщину и типы линий границ, изменять цвета фонов ячеек и т.п.).
Vladimir Chebykin Пользователь Сообщений: 1225 |
#1 20.07.2018 13:40:13 Добрый день! какой макрос использовать, чтобы сводные автоматом обновлялись при изменении данных?. Метод/свойство в следующем макросе не подходит в моем случае:
потому что данный макрос размещается в модкле листа,а у меня в процессе работы лист с исходный таблицей полностью удаляется и заменяется другим, соответственно вместе с листом удаляется и макрос из примера выше. Думаю, что нужен макрос для размещения в модуле книги, который бы отслеживал изменения в таблицах и обновлял сводную. Подскажете, как можно решить проблему? |
||
mrzv Пользователь Сообщений: 44 |
Я вас не пойму, если исходный лист из которого сделана сводная удаляется, то тогда откуда ей обновляться? |
mrzv, при обновлении данных из другого файла копируется новый лист с новой таблицей. Названия листа и умной таблицы присваиваются те же, что были в «старом» удаленном листе, поэтому сводная без проблем «перекидывает» свой источник данных на новую таблицу. Надеюсь, понятно объяснил.. Все делается автоматом макросами. |
|
Андрей VG Пользователь Сообщений: 11878 Excel 2016, 365 |
#4 20.07.2018 15:15:51 Доброе время суток.
Изменено: Андрей VG — 20.07.2018 15:17:29 |
||
Андрей VG, спасибо, но немного не то. Мне надо, чтобы автоматом обновлялось при изменении исходных данных. А тут получается, что макрос нужно выполнить принудительно (размещаю просто в модуль). При размещении макроса в модуле книги, обновления не происходит. Хотя может я что-то делаю не так — в VBA я только начинаю.. П.С. если потребуется пример, то смогу только в понедельник..хотя мне трудно представить пример, в котором лист с исходной таблицей заменяется новым листом Изменено: Vladimir Chebykin — 20.07.2018 16:01:07 |
|
Андрей VG Пользователь Сообщений: 11878 Excel 2016, 365 |
#6 20.07.2018 16:13:48
ну, так и вызовите его после изменения. |
||
смысл какой? Куда правильнее обновлять при переходе на лист со сводной таблицей. Или это не тот случай? Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы… |
|
Vladimir Chebykin Пользователь Сообщений: 1225 |
#8 23.07.2018 07:54:56 Дмитрий(The_Prist) Щербаков, спасибо за подсказку! Как это часто бывает, все оказалось намного проще — нужно было лишь по другому взглянуть на проблему, Worksheet_Activate решает задачу:
|
||
Андрей VG Пользователь Сообщений: 11878 Excel 2016, 365 |
#9 23.07.2018 09:40:18
И каждый раз, нужно это или не нужно — обновлять сводную? А если обновление минуты 2 или больше? |
||
Андрей VG, в моем случае — это около 1000 строк и 30 столбцов без формул, т.е. занимает доли секунды. просто Ваш код я не смог «прикрутить» , чтобы сводная автоматом обновлялась при изменении исходника ( может просто потому что я «не шарю» в макросах, о чем писал в сообщении #5) — только принудительно. |
|
skais675 Пользователь Сообщений: 2177 |
#11 23.07.2018 10:15:46
Так вот на этом этапе и нужно ее обновить теми же маросами. Мой канал |
||
Vladimir Chebykin Пользователь Сообщений: 1225 |
#12 23.07.2018 10:37:55
Наверное, я не до конца выразил задачу. Таблица обновилась — ок, но в дальнейшем с ней продолжают работать, а именно: изменять комментарии. Вся фишка в том, что необходимо видеть изменяемые комментарии. Ладно, чтобы было яснее во вложении пример, который обещал в сообщении 5 (хотя задачу уже решил). Прикрепленные файлы
|
||
skais675 Пользователь Сообщений: 2177 |
Ну я бы Изменено: skais675 — 23.07.2018 11:12:11 |
Vladimir Chebykin Пользователь Сообщений: 1225 |
#14 23.07.2018 11:38:46
возможно ли это сделать автоматом? например макрос из сообщения №1 автоматически вставлять в модуль нового листа? |
||
skais675 Пользователь Сообщений: 2177 |
#15 23.07.2018 11:56:01 Здесь Мой канал |