«Bill Jelen, Mr. Excel Tracy Syrstad 800 East 96th Street Indianapolis, Indiana 46240 ?изнес-решения Применение VBA и макросов в Microsoft® Excel Билл Джелен, “Мистер Excel” Трейси Сирстад Москва • Санкт-Петербург • Киев ...»

PT.AddFields RowFields:=Array("Товар", "Заказчик"), _ ColumnFields:="Регион" Чтобы добавить поле Выручка к области данных сводной таблицы, уста новите значение свойства Orientation этого поля равным xlDataField (рассматривается в следующем разделе).

Подсчет суммы чисел вместо количества значений При добавлении поля Выручка к области данных сводной таблицы Excel вполне логично предполагает, что вы хотите подсчитать сумму выручки. К со жалению, это справедливо только при условии, что все без исключения ячей ки столбца Выручка содержат числовые данные. Если хотя бы одна ячейка будет содержать нечисловые данные (например, окажется пустой), вместо суммы чисел Excel подсчитает количество значений.

Определяя макет сводной таблицы с помощью пользовательского интер фейса, убедитесь, что название кнопки Выручка изменилось в результате ее перетаскивания в область Данные (DATA) на Сумма по полю Выручка (Sum of Выручка), а не на Количество по полю Выручка (Count of Выручка). Чтобы изменить функцию подсчета количества значений на функцию подсчета сум мы чисел, исправьте исходные данные или же дважды щелкните на кнопке Количество по полю Выручка, после чего ее название изменится на Сумма по полю Выручка.

Для того чтобы указать на необходимость применения функции подсчета суммы чисел в коде VBA, установите значение свойства Function поля Выручка равным xlSum, как показано ниже:

' Определить область данных.

With PT.PivotFields("Выручка").Orientation = xlDataField.Function = xlSum.Position = End With Задав все необходимые параметры сводной таблицы, пересчитайте ее, ус тановив значение свойства ManualUpdate равным False, а затем вновь за претите автоматический пересчет, установив значение свойства ManualUpdate равным True, как показано далее:

306 Часть II Автоматизация Excel ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True Ниже приведен полный код макроса, создающего сводную таблицу, ана логичную показанной на рис. 12.5:

Sub CreatePivot() Dim PTCache As PivotCache Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Добавить поля к области строк и области столбцов сводной таблицы.

PT.AddFields RowFields:=Array("Товар", "Заказчик"), _ ColumnFields:="Регион" ' Определить область данных.

With PT.PivotFields("Выручка") ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True Перемещение или изменение части сводной таблицы Excel не разрешает перемещать или изменять часть сводной таблицы.

К примеру, создайте макрос, удаляющий столбец, который содержит общую сумму по строкам сводной таблицы (в данном случае столбец O). В резуль тате выполнения макроса будет сгенерирована ошибка времени выполне ния 1004, как показано на рис. 12.7.

Определение размера сводной таблицы Определить размер сводной таблицы заранее достаточно сложно. Например, рассматриваемая сводная таблица может содержать как 5, так и 6 столбцов в за висимости от того, была ли заключена в западном регионе хотя бы одна сделка.

Чтобы обратиться ко всей сводной таблице, необходимо воспользоваться ее свойством TableRange2.

Поскольку Excel не разрешает перемещать или изменять часть сводной таблицы, рекомендуется скопировать содержимое ячеек сводной таблицы в другое место и удалить исходную таблицу. Рассмотрим макрос CreateSummaryReportUsingPivot, который создает небольшую сводную таблицу.

Чтобы запретить добавление к сводной таблице столбца Общий итог (Grand Total) и одноименной строки, установите равными False значения свойств ColumnGrand и RowGrand, соответственно.

Диапазон ячеек PT.TableRange2 охватывает всю сводную таблицу, включая строку с кнопкой Сумма по полю Выручка (Sum of Выручка). Чтобы избавиться от этой строки, необходимо сместить ссылку PT.TableRange2 на одну строку вниз (Offset(1, 0)). Если сводная таблица содержит несколь ко строк с избыточной информацией, сместите ссылку PT.TableRange2 на соответствующее число строк.

Для вставки содержимого ячеек диапазона PT.TableRange2.Offset(1, 0) в область, начинающуюся ячейкой J10, применяется метод PasteSpecial. На рис. 12.8 показано содержимое рабочего листа после копирования ячеек свод ной таблицы.

Чтобы удалить сводную таблицу, ‘‘очистите’’ диапазон ячеек PT.TableRange2 с помощью метода Clear. Если вы затем собираетесь форматировать рабочий лист, удалите объект PivotCache из памяти, присвоив соответст вующей переменной (в данном случае PTCache) значение Nothing.

308 Часть II Автоматизация Excel Рис. 12.8. Содержимое рабочего листа перед удалением свод Sub CreateSummaryReportUsingPivot() ' Этот макрос создает статический отчет ' на основе сводной таблицы.

Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить область строк и область столбцов сводной таблицы.

PT.AddFields RowFields:="Регион", ColumnFields:="Товар" ' Определить область данных.

With PT.PivotFields("Выручка") ' Запретить создание итогового столбца и итоговой строки.

' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True ' Скопировать содержимое ячеек диапазона ' PT.TableRange2.Offset(1, 0) в область, ' начинающуюся ячейкой J10.

PT.TableRange2.Offset(1, 0).Copy WSD.Range("J10").PasteSpecial xlPasteValues ' Содержимое рабочего листа на текущий ' момент показано на рис. 12.8.

' Удалить сводную таблицу и объект кэша сводных таблиц.

PT.TableRange2.Clear Set PTCache = Nothing End Sub Далее в этой главе рассматриваются более сложные примеры использова ния сводных таблиц.

Создание отчета о структуре спроса на товары Отчет о структуре спроса на товары может быть полезен менеджерам по про дажам, поскольку он позволяет получить наглядное представление об объе мах закупок товаров разными заказчиками. Отчет, показанный на рис. 12.9, содержит список заказчиков в порядке убывания общего объема закупок в трех регионах: центральном, восточном и западном.

Рис. 12.9. 90% этого отчета создано с помощью сводной 310 Часть II Автоматизация Excel Чтобы создать такой отчет, следует воспользоваться сводной таблицей.

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

Тем не менее, первый шаг в подготовке отчета о структуре спроса на това ры состоит в создании сводной таблицы с полями Товар и Заказчик в облас ти строк, полем Регион в области столбцов и полем Выручка в области дан ных (рис. 12.10).

Рис. 12.10. В основе отчета о структуре спроса на товары лежит сводная таблица Ниже перечислены очевидные недостатки стандартной сводной таблицы с двумя полями в области строк.

Внешний вид стандартной сводной таблицы оставляет желать лучшего.

Как показано на рис. 12.10, значение ‘‘ABC’’ встречается в столбце Товар всего один раз, а следующие за ним 26 ячеек и вовсе оставлены пустыми. Это одна из наиболее серьезных недоработок сводных таб лиц, устранить которую весьма непросто. Безусловно, большинство пользователей догадаются, о каком товаре идет речь, однако если часть отчета, посвященная товару ABC, будет занимать 2 и более страницы, могут возникнуть определенные трудности. Кроме того, подобный способ представления данных затрудняет их повторное использование.

Область данных отчета содержит пустые ячейки вместо нулей. Как по казано на рис. 12.10, заказчик BCD LTD. приобрел товар ABC только в западном регионе, что побудило Excel оставить пустыми ячейки, со ответствующие объемам закупок товара ABC заказчиком BCD LTD.

В восточном и центральном регионах. Это может не понравиться опытным пользователям Excel, привыкшим перемещаться по блокам данных с помощью последовательного нажатия клавиши и од ной из клавиш со стрелками.

Название отчета заслуживает отдельного внимания. Вряд ли кому нибудь понравится, чтобы предоставленный ему отчет имел заголовок Сумма по полю Выручка (Sum of Выручка).

Заголовки некоторых столбцов сводной таблицы избыточны. К приме ру, слово ‘‘Регион’’, помещенное в ячейку L2 (см. рис. 12.10), и вовсе не относится к отчету.

Стандартный порядок сортировки (по алфавиту), применяемый в сводной таблице, не всегда используется на практике. В частности, менеджеры по продажам предпочитают, чтобы список заказчиков был отсортирован в по рядке убывания суммы закупок товара. Кроме того, последовательность регионов ‘‘Восток Запад Центр’’ не соответствует их естественному гео графическому расположению (‘‘Запад Центр Восток’’).

Автоматически сгенерированные границы определенно не красят отчет.

При отображении числовых значений используется формат Общий (General), хотя для подобных отчетов больше подходит формат с разде лителем групп разрядов и округлением чисел до тысяч или миллионов.

Сводные таблицы не поддерживают вставку разрыва страницы между различными частями отчета. Если отчет предназначен для нескольких менеджеров по продажам, каждый из которых курирует определенный товар, разрывы страниц придется добавлять самостоятельно.

Ввиду невозможности вставки разрывов страниц между различными частями отчета, целесообразно отказаться от автоматического создания строк с промежуточными итогами сводной таблицы и добавить строки с промежуточными итогами и разрывы страниц вручную с помощью метода Subtotal. Excel генерирует строки с промежуточными итогами при наличии в области строк сводной таблицы двух и более полей (на рис. 12.10 показана строка с промежуточными итогами для поля Товар). Например, при наличии в области строк 4 х полей Excel сгенери рует 3 строки с промежуточными итогами для 3 х первых полей.

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

312 Часть II Автоматизация Excel Заполнение значениями пустых ячеек в области данных Пустые ячейки начали досаждать пользователям со времен первой реали зации сводных таблиц в Excel 95. Начиная с Excel 97, Microsoft предоставляет возможность указать значение, которое будет отображаться в пустых ячейках.

Чтобы задать значение, которое будет отображаться в пустых ячейках, открой те диалоговое окно Параметры сводной таблицы (PivotTable Options). Для этого щелкните на кнопке Параметры (Options) диалогового окна Мастер сводных таблиц и диаграмм — шаг 3 из 3 (PivotTable and PivotChart Wizard — Step 3 of 3) или выберите команду Параметры таблицы (Table Options) из рас крывающегося списка Сводная таблица (PivotTable) панели инструментов Сводные таблицы (PivotTable). Установите флажок Для пустых ячеек отображать (For empty cells, show) и введите 0 в расположенном справа от флажка текстовом поле (рис. 12.11).

Рис. 12.11. Установите флажок Для пустых ячеек отображать и введите значение, которое будет отображаться в пустых ячейках области данных сводной таблицы, в расположенном Чтобы выполнить эквивалентное действие в VBA, установите значение свойства объекта сводной таблицы NullString равным "0".

Несмотря на то что в коде VBA значение, которое будет отображаться в пустых ячейках, задается как текстовый нуль, Excel помещает в пустые ячейки число Изменение порядка сортировки списка заказчиков Средства пользовательского интерфейса Excel позволяют отсортировать список заказчиков в порядке убывания суммы закупок товара. Дважды щелк ните на кнопке сводной таблицы Заказчик, в результате чего откроется диа логовое окно Вычисление поля сводной таблицы (PivotTable Field), показан ное на рис. 12.12.

Рис. 12.12. Чтобы добраться до параметров сортировки сводной таблицы, щелкните на кнопке Дополнительно Щелкните на кнопке Дополнительно (Advanced), в результате чего откро ется диалоговое окно Дополнительные параметры поля сводной таблицы (PivotTable Field Advanced Options). Установите переключатель По убыванию (Descending) и выберите из расположенного под переключателем раскрываю щегося списка значение Сумма по полю Выручка (Sum of Выручка), как пока зано на рис. 12.13.

Рис. 12.13. Диалоговое окно Дополнительные параметры поля сводной таблицы позволяет выбрать порядок сорти ровки содержимого поля сводной таблицы Чтобы выполнить эквивалентное действие в VBA, воспользуйтесь методом AutoSort:

PT.PivotFields("Заказчик").AutoSort Order:=xlDescending, _ Field:="Сумма по полю Выручка" 314 Часть II Автоматизация Excel Изменение порядка следования столбцов сводной таблицы вручную Последовательность регионов столбцов сводной таблицы ‘‘Восток Запад Центр’’ не соответствует их естественному географическому распо ложению (‘‘Запад Центр Восток’’), что может смутить конечных пользо вателей отчета.

Microsoft предлагает весьма экстравагантный способ изменения порядка следования столбцов сводной таблицы, получивший название ручной сорти ровки. Как показано на рис. 12.10, по умолчанию Excel выстраивает столбцы сводной таблицы по алфавиту: Восток, Запад, Центр (заголовки столбцов находятся в ячейках L3:N3, соответственно). Чтобы изменить порядок следо вания столбцов с помощью пользовательского интерфейса, введите в ячейке N3 слово ‘‘Восток’’. Как по мановению волшебной палочки, Excel сместит столбцы Запад и Центр на одну позицию влево и перенесет столбец Восток на место бывшего столбца Центр (рис. 12.14).

Рис. 12.14. Чтобы изменить стандартный порядок следования столб цов сводной таблицы Восток, Запад, Центр с помощью пользова тельского интерфейса, введите в ячейке N3 слово “Восток” Чтобы выполнить эквивалентное действие в VBA, измените значение свойства Position соответствующего столбца сводной таблицы. Поскольку гарантии того, что столбец с заданным заголовком будет присутствовать в ис ходных данных, нет, отключите обработку ошибок, как показано ниже (обработке ошибок посвящена глава 23, ‘‘Обработка ошибок’’):

On Error Resume Next PT.PivotFields("Регион").PivotItems("Восток").Position = On Error GoTo Изменение формата отображения числовых значений Чтобы изменить формат отображения числовых значений сводной табли цы с помощью пользовательского интерфейса, дважды щелкните на кнопке Сумма по полю Выручка (Sum of Выручка). В открывшемся диалоговом окне Вычисление поля сводной таблицы (PivotTable Field) щелкните на кнопке Формат (Number) и выберите требуемый формат с помощью диалогового окна Формат ячеек (Format Cells).

При работе с большими числами рекомендуется использовать формат с разделителем групп разрядов. Ниже приведен пример задания маски формата с разделителем групп разрядов в VBA:

PT.PivotFields("Сумма по полю Выручка").NumberFormat = "#,##0" Зачастую суммы заказов товаров исчисляются в тысячах, а то и в миллио нах. Чтобы округлить числовое значение до тысяч, добавьте в конец маски формата запятую и, при желании, аббревиатуру ‘‘K’’:

PT.PivotFields("Сумма по полю Выручка").NumberFormat = "#,##0,K" Некоторые компании по старой привычке используют в качестве показате ля тысяч аббревиатуру ‘‘M’’, а в качестве показателя миллионов аббревиа туру ‘‘MM’’. Чтобы использовать в качестве показателя тысяч аббревиатуру ‘‘M’’, предварите ее символом обратной косой черты:

PT.PivotFields("Сумма по полю Выручка").NumberFormat = "#,##0,\M" Символ обратной косой черты можно заменить двойными кавычками.

Особенность употребления двойных кавычек внутри строки в кавычках в коде VBA заключается в необходимости дублировать каждый символ двойной ка вычки. Ниже приведен пример задания маски #,##0.0,,"MM", использую щейся для округления числовых значений до десятков миллионов с аббревиа турой ‘‘MM’’:

PT.PivotFields("Сумма по полю Выручка").NumberFormat = _ "#,##0.0,,""MM""" Запрет автоматического добавления промежуточных итогов Excel автоматически генерирует промежуточные итоги при наличии в об ласти строк сводной таблицы двух и более полей. Строки с промежуточными итогами создаются для всех полей, за исключением последнего. Ввиду невоз можности вставки разрывов страниц между частями отчета, относящимися к 316 Часть II Автоматизация Excel разным товарам, целесообразно отказаться от автоматического добавления промежуточных итогов сводной таблицы и добавить промежуточные итоги и разрывы страниц вручную с помощью метода Subtotal.

Чтобы запретить автоматическое добавление промежуточных итогов для поля Товар с помощью пользовательского интерфейса Excel, дважды щелк ните на кнопке Товар и установите переключатель Нет (None) в открывшемся диалоговом окне Вычисление поля сводной таблицы (PivotTable Field), как показано на рис. 12.15.

Чтобы выполнить аналогичное действие в VBA, придется изрядно потрудить ся, а именно установить значение свойства поля Subtotals равным массиву, со стоящему из 12 значений False. Первое значение False запрещает автоматиче ское добавление промежуточных итогов, второе значение False — подсчет сум мы, третье значение False — подсчет количества и т.д. (полный синтаксис свойства Subtotals приводится в справочной системе VBA). Следующий код за прещает создание строки с промежуточными итогами для поля Товар:

PT.PivotFields("Товар").Subtotals = Array(False, False, False, _ False, False, False, False, False, False, False, False, False) Чтобы сделать код более удобочитаемым, можно создать переменную, хра нящую массив из 12 значений False:

NoSubtotalArray = Array(False, False, False, False, False, _ False, False, False, False, False, False, False) PT.PivotFields("Товар").Subtotals = NoSubtotalArray PT.PivotFields("Дата").Subtotals = NoSubtotalArray Запрет подсчета общей суммы по столбцам Логичным продолжением запрета автоматического добавления промежу точных итогов сводной таблицы будет запрет подсчета общей суммы по столбцам, помещаемой в строку Общий итог (Grand Total). Откройте диало говое окно Параметры сводной таблицы (PivotTable Options) (см. рис. 12.11).

Чтобы запретить создание строки Общий итог, снимите флажок Общая сумма по столбцам (Grand totals for columns) (чтобы запретить создание од ноименного столбца, сбросьте флажок Общая сумма по строкам (Grand totals for rows)). Ниже приведен соответствующий код VBA:

PT.ColumnGrand = False Создание отчета о структуре спроса на товары:

завершающая стадия В предыдущем разделе были рассмотрены изменения, которые можно вно сить непосредственно в сводную таблицу Excel. Все оставшиеся действия по созданию отчета о структуре спроса на товары требуют копирования значений сводной таблицы (но не саму таблицу!) в другое место.

На рис. 12.16 показана сводная таблица после выполнения всех действий, описанных в предыдущем разделе.

Рис. 12.16. Менее 1 секунды и 30 строк программного кода понадобилось для того, чтобы преодолеть более 90% пути к отчету о структуре спроса на 318 Часть II Автоматизация Excel Создание новой рабочей книги Предположим, что отчет о структуре спроса на товары необходимо размес тить в новой рабочей книге, чтобы отправить ее затем по электронной почте.

С целью сделать код более универсальным, создадим объектные переменные для текущей рабочей книги, новой рабочей книги и первого рабочего листа в новой рабочей книге (см. практикум ‘‘Использование двух расширенных фильтров для создания отчетов по каждому заказчику’’ на с. 293). Добавьте следующий код в начало макроса:

Dim WSD As Worksheet Dim WSR As Worksheet Dim PTCache As PivotCache Dim PT As PivotTable Set WBO = ActiveWorkbook Set WSD = Worksheets("Данные") После построения и пересчета сводной таблицы создайте новую рабочую книгу, как показано ниже:

' Создать новую рабочую книгу с одним листом.

Set WBN = Workbooks.Add(xlWBATWorksheet) Set WSR = WBN.Worksheets(1) WSR.Name = "Отчет" ' Создать заголовок отчета.

With WSR.[A1].Value = "Отчет о структуре спроса на товары" Копирование содержимого сводной таблицы Среди недостатков сводной таблицы, показанной на рис. 12.16, следует от метить наличие границ, неудачный заголовок и совершенно ненужное слово ‘‘Регион’’ в ячейке L2. Все это можно устранить путем копирования содержи мого диапазона ячеек PT.TableRange2 (за исключением первой строки) и его вставки в новый рабочий лист с помощью метода PasteSpecial со зна чением параметра Paste, равным xlPasteValuesAndNumberFormats.

Как уже отмечалось, диапазон ячеек PT.TableRange2 содержит одну из быточную строку — строку 2 (см. рис. 12.16). Более сложные сводные таблицы с несколькими полями в области столбцов или области страницы будут со держать несколько таких строк (определить точное количество ненужных строк поможет анализ макета сводной таблицы). Чтобы исключить избыточ ные строки из копируемого диапазона ячеек, воспользуйтесь его свойством Offset. Можно справедливо заметить, что смещение ссылки на диапазон ячеек PT.TableRange2 приведет к захвату лишних строк под сводной табли цей, однако это несущественно, так как эти строки пустые. После копирова ния содержимого сводной таблицы ее можно удалить с рабочего листа, а соот ветствующий объект PivotCache — из памяти компьютера:

' Скопировать содержимое сводной таблицы и поместить ' его на рабочий лист "Отчет". Свойство Offset используется ' для исключения из копируемого диапазона ячеек строки с ' заголовком сводной таблицы.

PT.TableRange2.Offset(1, 0).Copy WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats PT.TableRange2.Clear Set PTCache = Nothing Обратите внимание, что метод PasteSpecial копирует только значения и форматы чисел, что позволяет избавиться как от границ, так и от самой струк туры сводной таблицы. Последнее необходимо для возможности вставки в скопированные данные новых строк.

Улучшение внешнего вида отчета Как показано на рис. 12.17, большинство ячеек в столбце A пусты.

Рис. 12.17. Пустые ячейки — это одна из наиболее сущест венных недоработок сводных таблиц, устранить которую Чтобы заполнить пустые ячейки столбца A соответствующими значениями с помощью пользовательского интерфейса Excel, выполните следующие действия.

320 Часть II Автоматизация Excel 1. Выделите все ячейки столбца A, в которых должно содержаться наиме 2. Выберите команду меню Правка Перейти (Edit Go To), в результате чего откроется диалоговое окно Переход (Go To). Щелкните на кнопке Выделить (Special) и установите в открывшемся диалоговом окне Выделение группы ячеек (Go To Special) переключатель Пустые ячейки (Blanks) (рис. 12.18).

3. Заполните пустые ячейки R1C1 формулой, ссылающейся на ячейку выше (=R[-1]C). Чтобы сделать это с помощью пользовательского ин терфейса, введите знак равенства, нажмите клавишу, а затем 4. Выделите все ячейки столбца A, в которых содержится наименование товара. Необходимость этого шага обусловлена тем, что функция спе циальной вставки (см. следующий шаг) не поддерживает работу с не смежными диапазонами ячеек.

5. Скопируйте выделенные ячейки и вставьте их с помощью команды Правка Специальная вставка (Edit Paste Special), установив в от крывшемся диалоговом окне Специальная вставка (Paste Special) пере ключатель Значения (Values).

Достижение аналогичного результата с помощью VBA можно разбить на 3 этапа.

1. Вычисление номера последней строки отчета.

2. Вставка формулы =R[-1]C в пустые ячейки столбца A.

3. Замена формул значениями.

Ниже приведен соответствующий код VBA:

' Вычислить номер последней строки отчета по столбцу B.

FinalReportRow = WSR.Range("B65536").End(xlUp).Row With Range("A3").Resize(FinalReportRow - 2, 1) With.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C".Value =.Value End With Стилевое форматирование отчета Прежде чем добавить строки с промежуточными итогами, применим к от чету стилевое форматирование. Для этого выделим полужирным шрифтом заголовки столбцов отчета (строка 3) и выровняем их по правому краю ячейки (за исключением столбцов A и B, которые нужно выровнять по левому краю ячейки). Последняя строка приведенного ниже кода указывает на необходи мость печати на каждой странице трех первых строк отчета:

' Стилевое форматирование отчета:

' - выделение полужирным шрифтом заголовков столбцов;

' - выравнивание заголовков столбцов по правому краю (за исключением столбцов A-B, которые выравниваются по правому краю).

Selection.Columns.AutoFit Range("A3").EntireRow.Font.Bold = True Range("A3").EntireRow.HorizontalAlignment = xlRight Range("A3:B3").HorizontalAlignment = xlLeft ' Печатать на каждой странице строки 1-3 отчета.

WSR.PageSetup.PrintTitleRows = "$1:$3" Добавление промежуточных итогов Чтобы добавить промежуточные итоги с помощью пользовательского ин терфейса Excel, выделите область данных отчета (включая заголовки столб цов) и выберите команду меню Данные Итоги (Data Subtotals). Проверьте, чтобы в открывшемся диалоговом окне Промежуточные итоги (Subtotals) был установлен флажок Конец страницы между группами (Page breaks between groups), как показано на рис. 12.19.

322 Часть II Автоматизация Excel Если отчет о структуре спроса на товары всегда содержит столбцы Запад, Центр и Восток, для добавления промежуточных итогов можно воспользо ваться следующим кодом:

' Добавление промежуточных итогов со вставкой ' разрыва страницы между группами данных.

Selection.Subtotal GroupBy:=1, Function:=xlSum, _ TotalList:=Array(3, 4, 5, 6), Replace:=True, PageBreaks:=True, _ SummaryBelowData:=True К сожалению, выполнение этого кода приведет к ошибке при изменении количества столбцов, соответствующих регионам. Решение этой проблемы состоит в динамическом создании массива столбцов, по которым нужно под водить промежуточные итоги:

FinalCol = Cells(3, 255).End(xlToLeft).Column ReDim Preserve TotColumns(1 To FinalCol - 2) Selection.Subtotal GroupBy:=1, Function:=xlSum, _ TotalList:=TotColumns, Replace:=True, PageBreaks:=True, _ SummaryBelowData:=True Наконец, необходимо подобрать ширину столбцов отчета в соответствии с добавленными в него строками:

' Автоподбор ширины столбцов отчета.

GrandRow = Range("A65536").End(xlUp).Row Cells(GrandRow, 3).Resize(1, 4).Columns.AutoFit Cells(GrandRow, 3).Resize(1, 4).NumberFormat = "#,##0,K" ' Добавить разрыв страницы перед ' строкой "Общий итог" (Grand Total).

WSR.HPageBreaks.Add Before:=Cells(GrandRow, 1) Результирующий код Ниже приведен полный код макроса, создающего отчет о структуре спроса на товары:

Sub ProductLineManagerReport() Dim WSD As Worksheet Dim WSR As Worksheet Dim WBO As Workbook Dim WBN As Workbook Dim PTCache As PivotCache Dim PT As PivotTable Dim PRange As Range Dim TotColumns() Dim FinalRow As Long Dim FinalReportRow As Long Dim FinalCol As Integer Dim i As Integer Dim GrandRow As Long Dim NoSubtotalArray As Variant Set WBO = ActiveWorkbook Set WSD = Worksheets("Данные") ' Удалить все существующие сводные таблицы.

For Each PT In WSD.PivotTables PT.TableRange2.Clear ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк.

PT.AddFields RowFields:=Array("Товар", "Заказчик"), _ ColumnFields:="Регион" ' Определить поля области данных.

With PT.PivotFields("Выручка").Orientation = xlDataField.NumberFormat = "#,##0,K" ' Заполнить нулями пустые ячейки в области данных.

PT.NullString = "0" ' Запретить вставку строки "Общий итог" (Grand Total).

PT.ColumnGrand = False 324 Часть II Автоматизация Excel ' Запретить Excel автоматически вставлять ' строки с промежуточными итогами.

NoSubtotalArray = Array(False, False, False, False, False, _ False, False, False, False, False, False, False) PT.PivotFields("Товар").Subtotals = NoSubtotalArray ' Отсортировать список заказчиков ' в порядке убывания суммы закупок товара.

PT.PivotFields("Заказчик").AutoSort Order:=xlDescending, _ Field:="Сумма по полю Выручка" Изменить порядок следования столбцов сводной таблицы так, чтобы был соблюден естественный порядок следования регионов "Запад"-"Центр"-"Восток". Отключить обработку ошибок на случай, если столбец "Восток" не существует.

PT.PivotFields("Регион").PivotItems("Восток").Position = ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True ' Создать новую рабочую книгу с одним листом.

Set WBN = Workbooks.Add(xlWBATWorksheet) Set WSR = WBN.Worksheets(1) ' Создать заголовок отчета.

.Value = "Отчет о структуре спроса на товары" Скопировать содержимое сводной таблицы и поместить его на рабочий лист "Отчет". Свойство Offset используется для исключения из копируемого диапазона ячеек строки с заголовком сводной таблицы.

PT.TableRange2.Offset(1, 0).Copy WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats PT.TableRange2.Clear ' Вычислить номер последней строки отчета по столбцу B.

FinalReportRow = WSR.Range("B65536").End(xlUp).Row With Range("A3").Resize(FinalReportRow - 2, 1) With.SpecialCells(xlCellTypeBlanks) ' Стилевое форматирование отчета:

' - выделение полужирным шрифтом заголовков столбцов;

' - выравнивание заголовков столбцов по правому краю (за исключением столбцов A-B, которые выравниваются по правому краю).

Selection.Columns.AutoFit Range("A3").EntireRow.Font.Bold = True Range("A3").EntireRow.HorizontalAlignment = xlRight Range("A3:B3").HorizontalAlignment = xlLeft ' Печатать на каждой странице строки 1-3 отчета.

WSR.PageSetup.PrintTitleRows = "$1:$3" ' Добавление промежуточных итогов со вставкой ' разрыва страницы между группами данных.

'Selection.Subtotal GroupBy:=1, Function:=xlSum, _ ' TotalList:=Array(3, 4, 5, 6), Replace:=True, _ ' PageBreaks:=True, SummaryBelowData:=True Выполнение приведенного выше кода приведет к ошибке при изменении количества столбцов, соответствующих регионам.

Решение этой проблемы состоит в динамическом создании массива столбцов, по которым нужно подводить промежуточные итоги.

FinalCol = Cells(3, 255).End(xlToLeft).Column ReDim Preserve TotColumns(1 To FinalCol - 2) For i = 3 To FinalCol Selection.Subtotal GroupBy:=1, Function:=xlSum, _ TotalList:=TotColumns, Replace:=True, PageBreaks:=True, _ SummaryBelowData:=True ' Автоподбор ширины столбцов отчета.

GrandRow = Range("A65536").End(xlUp).Row Cells(GrandRow, 3).Resize(1, 4).Columns.AutoFit Cells(GrandRow, 3).Resize(1, 4).NumberFormat = "#,##0,K" ' Добавить разрыв страницы ' перед строкой "Общий итог" (Grand Total).

WSR.HPageBreaks.Add Before:=Cells(GrandRow, 1) ' Изменить заголовок последнего столбца ' отчета с "Общий итог" (Grand Total) на "Всего".

Cells(3, FinalCol).Value = "Всего" MsgBox "Отчет о структуре спроса на товары успешно создан."

End Sub На рис. 12.20 показана первая страница отчета, созданного с помощью макроса ProductLineManagerReport.

Рис. 12.20. Без применения сводных таблиц для создания подоб ного отчета понадобилось бы разработать гораздо более сложный 326 Часть II Автоматизация Excel Создание отчета о прибыльности товаров Отчет о структуре спроса на товары продемонстрировал лишь часть воз можностей сводных таблиц. В частности, область данных рассмотренной вы ше сводной таблицы содержала всего одно поле Область данных сводной таблицы, использующейся для создания отчета о бестоимость и Прибыль. В итоговом отчете должна быть отражена следую щая информация: общее количество проданного товара, общая выручка от продажи товара, средняя цена единицы товара, общая себестоимость продан ного товара, средняя себестоимость единицы товара, валовая прибыль и вало вая прибыль в процентах.

На рис. 12.21 показан макет сводной таблицы, созданный с помощью поль зовательского интерфейса Excel.

По умолчанию Excel помещает поля области данных сводной таблицы в последовательные ячейки столбца, как показано на рис. 12.22.

С помощью пользовательского интерфейса Excel перетащите кнопку Данные на кнопку Товар и отпустите ее. К сожалению, сводная таблица, по казанная на рис. 12.23, все еще не пригодна для создания отчета.

Выходом из сложившейся ситуации является перенесение поля Данные в область столбцов сводной таблицы. Начав перетаскивать кнопку Данные, об ратите внимание на форму курсора мыши. Область сводной таблицы, в кото рую будет перенесено поле, обозначена синим цветом (рис. 12.24).

Рис. 12.23. Перемена мест полей Рис. 12.24. Область сводной таблицы, Данные и Товар не привела к в которую будет перенесено поле, обо Результат перенесения поля Данные в область столбцов сводной таблицы показан на рис. 12.25.

Рис. 12.25. После перенесения поля Данные в область столбцов сводная таблица стала напоминать вполне привычный финансовый отчет Если в область данных сводной таблицы помещается несколько полей, Ex cel автоматически объединяет их в виртуальное поле Данные. Чтобы опреде лить внешний вид сводной таблицы с помощью VBA, воспользуйтесь методом AddFields.

Сводная таблица, показанная на рис. 12.22, может быть получена в резуль тате выполнения следующей строки кода:

PT.AddFields RowFields:=Array("Товар", "Данные") А вот как добиться результата, показанного на рис. 12.23:

PT.AddFields RowFields:=Array("Данные", "Товар") 328 Часть II Автоматизация Excel Чтобы поместить поле Данные в область столбцов сводной таблицы, вос пользуйтесь приведенным ниже кодом:

PT.AddFields RowFields:="Товар", ColumnFields:="Данные" После добавления в область столбцов сводной таблицы поля Данные опре делите поля области данных:

' Определение полей области данных.

With PT.PivotFields("Количество").Orientation = xlDataField.NumberFormat = "#,##0".Name = "Общее количество" With PT.PivotFields("Выручка").Orientation = xlDataField.NumberFormat = "#,##0" With PT.PivotFields("Себестоимость").Orientation = xlDataField.NumberFormat = "#,##0".Name = "Общая себестоимость" With PT.PivotFields("Прибыль").Orientation = xlDataField.NumberFormat = "#,##0".Name = "Валовая прибыль" Определение вычисляемых полей области данных Сводные таблицы поддерживают два типа формул. Наиболее часто исполь зуемый тип формул предназначен для добавления к сводной таблице вычис ляемых полей. Подсчет значений вычисляемого поля осуществляется на осно ве итоговых значений полей, входящих в формулу вычисляемого поля. На пример, при создании поля СредняяЦена с помощью формулы Выручка/ Количество Excel вычислит общую сумму по полю Выручка, общую сумму по полю Количество и поделит первое значение на второе. В большинстве случаев это именно то, что нужно.

Чтобы добавить вычисляемое поле с помощью VBA, воспользуйтесь мето дом Add объекта CalculatedFields. Метод Add имеет два параметра: имя вычисляемого поля (Name) и его формула (Formula). Обратите внимание, что при определении вычисляемого поля с именем СредняяЦена Excel автомати чески создаст поле сводной таблицы Сумма по полю СредняяЦена (Sum of СредняяЦена), что выглядит весьма нелепо. Устранить недоразумение позво ляет свойство Name поля сводной таблицы. Также следует отметить, что имя поля сводной таблицы должно отличаться от имени соответствующего вычис ляемого поля.

Ниже приведен полный код макроса, создающего отчет о прибыльности товаров.

Sub AccountingReport() Dim WSD As Worksheet Dim PTCache As PivotCache Dim PT As PivotTable Dim PRange As Range Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables PT.TableRange2.Clear WSD.Range("J1:M1").EntireColumn.Clear ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк и области столбцов.

PT.AddFields RowFields:="Товар", ColumnFields:="Данные" ' Определить вычисляемые поля.

PT.CalculatedFields.Add Name:="СредняяЦена", _ Formula:="=Выручка/Количество" PT.CalculatedFields.Add Name:="СредняяСебестоимость ", _ Formula:="=Себестоимость/Количество" PT.CalculatedFields.Add Name:="ВаловаяПрибыль_%", _ Formula:="=Прибыль/Выручка" ' Определить поля области данных.

With PT.PivotFields("Количество").Orientation = xlDataField.NumberFormat = "#,##0".Name = "Общее количество" With PT.PivotFields("Выручка") 330 Часть II Автоматизация Excel With PT.PivotFields("СредняяЦена") With PT.PivotFields("Себестоимость") With PT.PivotFields("СредняяСебестоимость ").Name = "Средняя себестоимость" With PT.PivotFields("Прибыль") With PT.PivotFields("ВаловаяПрибыль_%") ' Заполнить нулями пустые ячейки в области данных.

' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True Результат выполнения макроса AccountingReport показан на рис. 12.26.

Рис. 12.26. Полученный отчет позволяет составить мнение о прибыльности товаров “Подводные камни” вычисляемых элементов В отличие от вычисляемых полей, вычисляемые элементы сводной таблицы редко используются на практике. Главная особенность вычисляемого элемента состоит в возможности его добавления к существующему полю сводной таблицы.

Рассмотрим пример использования вычисляемых элементов. Предполо жим, что одно подразделение компании занимается продажами товаров ABC и DEF, а другое подразделение продажами товара XYZ. Добавим к полю Товар элемент, вычисляющий сумму содержимого элементов ABC и DEF.

Sub CalculatedItemsAreEvil() Dim WSD As Worksheet Dim PTCache As PivotCache Dim PT As PivotTable Dim PRange As Range Dim FinalRow As Long Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables PT.TableRange2.Clear WSD.Range("J1:M1").EntireColumn.Clear ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк и области столбцов.

PT.AddFields RowFields:="Товар", ColumnFields:="Данные" ' Создать вычисляемый элемент в поле "Товар".

PT.PivotFields("Товар").CalculatedItems.Add _ "Подразделение1", "=ABC+DEF" ' Переместить вычисляемый элемент на 3-ю позицию.

PT.PivotFields("Товар").PivotItems( _ "Подразделение1").Position = With PT.PivotFields("Выручка").Orientation = xlDataField.NumberFormat = "#,##0" 332 Часть II Автоматизация Excel With PT.PivotFields("Прибыль") ' Заполнить нулями пустые ячейки в области данных.

' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True Результат выполнения макроса CalculatedItemsAreEvil показан на рис. 12.27.

Проанализируем содержимое поля Общая выручка полученной сводной таблицы. Подсчет значения вычисляемого элемента вполне корректен: 46 млн (товар ABC) плюс 47 млн (товар DEF) примерно равняются 93 млн. Однако итоговое значение общей выручки должно равняться 146 млн (93 млн плюс 53 млн), но никак не 241 млн! Очевидно, что при подсчете строки Общий итог (Grand Total) Excel не делает различие между обычными и вычисляемы ми элементами. Единственный способ исправить положение заключается в сокрытии строк, соответствующих товарам ABC и DEF:

With PT.PivotFields("Товар").PivotItems("ABC").Visible = False.PivotItems("DEF").Visible = False Результат выполнения измененного макроса показан на рис. 12.28.

Рис. 12.27. Использование вычисляемых эле Рис. 12.28. После сокрытия строк, соответст ментов чревато весьма неприятными послед вующих товарам ABC и DEF, сводная таблица Суммирование значений полей области данных сводной таблицы путем группирования Сводная таблица, показанная на рис. 12.29, содержит огромное число строк — по одной на каждый день отгрузки товара.

Рис. 12.29. До группирования сводная таблица со В большинстве случаев такая детализация отчета избыточна гораздо бо лее удобно анализировать итоговые объемы продаж за определенный проме жуток времени (например, месяц или квартал).

К счастью, Excel поддерживает группирование дат в сводной таблице. Это гораздо эффективнее использования загадочной формулы =A2+1-ДЕНЬ(A2) (=A2+1-DAY(A2)), преобразующей произвольную дату в дату, соответствую щую первому дню исходного месяца и года.

Чтобы сгруппировать даты с помощью пользовательского интерфейса Ex cel, выделите любую ячейку в столбце ДатаОтгрузки и выберите команду Группа и структура Группировать (Group and Show Detail) из раскрываю щегося списка Сводная таблица (PivotTable) панели инструментов Сводные таблицы (PivotTable). В открывшемся диалоговом окне Группирование (Grouping) выберите значения Месяцы (Months), Кварталы (Quarters), Годы (Years) и щелкните на кнопке ОК (рис. 12.30).

Перед выполнением указанных выше действий сводная таблица содержала поле ДатаОтгрузки с группированием дат по дням. После изменения спосо ба группирования дат сводная таблица также содержит поле ДатаОтгрузки, однако теперь даты в этом поле сгруппированы по месяцам. Кроме того, в сводную таблицу было добавлено два новых поля 334 Часть II Автоматизация Excel (Quarters). При группировании дат поле с наибольшей детализацией всегда перенимает имя исходного поля, а остальные поля добавляются к сводной таблице по мере необходимости.

Результат группирования дат сводной таблицы по месяцам, кварталам и годам показан на рис. 12.31.

Рис. 12.31. Сводные таблицы Excel поддерживают группирование дат по Чтобы выполнить аналогичное действие в VBA, следует воспользоваться методом Group. Метод Group должен быть применен к диапазону, состояще му из одной ячейки, ячейки с датой. Обратите внимание, что впервые в этой главе Excel позволяет ся пересчитать промежуточную сводную таблицу.

Прежде всего, создадим сводную таблицу с полем ДатаОтгрузки в облас ти столбцов и пересчитаем ее (это необходимо для заполнения поля ДатаОтгрузки данными). При группировании дат обратимся к свойству LabelRange, возвращающему заголовок соответствующего поля сводной таблицы.

Sub ReportByMonth() Dim WSD As Worksheet Dim PTCache As PivotCache Dim PT As PivotTable Dim PRange As Range Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables PT.TableRange2.Clear ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк и области столбцов.

PT.AddFields RowFields:="ДатаОтгрузки", ColumnFields:="Регион" With PT.PivotFields("Выручка").Orientation = xlDataField.NumberFormat = "#,##0".Name = "Общая выручка" ' Заполнить нулями пустые ячейки в области данных.

PT.NullString = "0" ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True ' Сгруппировать содержимое столбца "ДатаОтгрузки" ' по месяцам, кварталам и годам.

PT.PivotFields("ДатаОтгрузки").LabelRange.Group _ Start:=True, End:=True, Periods:=Array(False, False, False, _ 336 Часть II Автоматизация Excel False, True, True, True) ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True Группирование дат по неделям Excel позволяет группировать даты по дням, месяцам, кварталам, годам, но не по неделям. Этот недочет легко исправить путем определения единицы группирования, состоящей из 7 дней.

По умолчанию Excel начинает группирование с первой даты исходных данных, в рассматриваемом случае с четверга 1 января 2004 года. Чтобы на чать группирование с понедельника, следует воспользоваться параметром Start метода Group. Функция Weekday поможет определить смещение пер вой даты исходных данных от начала недели.

Группирование по неделям имеет один существенный недостаток оно исключает возможность какого либо иного группирования. Другими словами, Excel не разрешает группировать даты по неделям и, к примеру, кварталам.

Ниже приведен код, реализующий группирование дат сводной таблицы по неделям.

Sub ReportByWeek() Dim PTCache As PivotCache Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк и области столбцов.

PT.AddFields RowFields:="ДатаОтгрузки", ColumnFields:="Регион" With PT.PivotFields("Выручка").NumberFormat = "#,##0".Name = "Общая выручка" ' Заполнить нулями пустые ячейки в области данных.

PT.NullString = "0" ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True ' Сгруппировать содержимое столбца "ДатаОтгрузки" по неделям.

' Определить дату понедельника 1-й недели.

FirstDate = PT.PivotFields("ДатаОтгрузки").LabelRange.Offset( _ 1, 0).Value WhichDay = Application.WorksheetFunction.Weekday(FirstDate, 3) StartDate = FirstDate - WhichDay PT.PivotFields("ДатаОтгрузки").LabelRange.Group _ Start:=StartDate, End:=True, By:=7, _ Periods:=Array(False, False, False, True, False, _ False, False) ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True End Sub Результат выполнения макроса ReportByWeek показан на рис. 12.32.

Рис. 12.32. При необходимости даты сводной таблицы можно сгруппировать по неделям 338 Часть II Автоматизация Excel Определение сроков выполнения заказов Как упоминалось выше, при группировании дат поле с наибольшей дета лизацией всегда перенимает имя исходного поля, а остальные поля (например, Годы (Years) или Кварталы (Quarters)) добавляются к сводной таблице по мере необходимости.

Предположим, что предприятию необходимо определить сроки выполне ния заказов. Полный цикл производства товара включает 12 недельную за держку, связанную с поставкой необходимых компонентов. В идеальной си туации на выполнение заказа отводится не менее 13 недель. В противном слу чае следует реализовать систему прогнозирования поступления заказов.

Добавив к исходным данным поле ДатаЗаказа, создадим сводную табли цу, показывающую поступление выручки от выполнения заказов по месяцам.

1. Создайте сводную таблицу с полем ДатаОтгрузки в области строк и полем Выручка в области данных. Сгруппируйте поле ДатаОтгрузки по месяцам и годам, в результате чего Excel создаст два новых поля ДатаОтгрузки и Годы (Years).

2. Поместите поля ДатаОтгрузки и Годы в область столбцов сводной 3. Добавьте поле ДатаЗаказа к области строк сводной таблицы.

4. Сгруппируйте поле ДатаЗаказа по месяцам и годам, в результате чего Следует отметить, что новые версии Excel корректно справляются с груп пировкой дат в нескольких полях сводной таблицы, подтверждением чего мо жет служить факт создания поля Годы2 вместо поля Годы.

Ниже приведен полный код макроса, создающего отчет о поступлении вы ручки от выполнения заказов по месяцам.

Sub MeasureLeadtime() Dim PTCache As PivotCache Set WSD = Worksheets("Данные (2)") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("K2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк.

PT.AddFields RowFields:="ДатаОтгрузки" With PT.PivotFields("Выручка").Orientation = xlDataField.NumberFormat = "#,##0".Name = "Общая выручка" ' Заполнить нулями пустые ячейки в области данных.

PT.NullString = "0" ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True ' Сгруппировать содержимое поля "ДатаОтгрузки" по месяцам и годам.

PT.PivotFields("ДатаОтгрузки").LabelRange.Group _ Start:=True, End:=True, Periods:=Array(False, False, False, _ False, True, False, True) ' Поместить поля "Годы" и "ДатаОтгрузки" в область столбцов.

With PT.PivotFields("Годы").Orientation = xlColumnField With PT.PivotFields("ДатаОтгрузки").Orientation = xlColumnField ' Добавить поле "ДатаЗаказа" в область строк.

With PT.PivotFields("ДатаЗаказа").Orientation = xlRowField ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True ' Сгруппировать содержимое поля "ДатаЗаказа" по месяцам и годам.

PT.PivotFields("ДатаЗаказа").LabelRange.Group _ Start:=True, End:=True, Periods:=Array(False, False, False, _ False, True, False, True) ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True End Sub 340 Часть II Автоматизация Excel Результат выполнения макроса MeasureLeadtime показан на рис. 12.33.

Рис. 12.33. Данный отчет свидетельствует о том, что пред приятие нуждается в гибкой системе прогнозирования по Дополнительные возможности сводных таблиц Зачастую даже опытные пользователи Excel не знакомы со всеми возмож ностями сводных таблиц. Восполним же этот пробел!

Отображение лучшей десятки заказчиков Согласно широко известному правилу 80/20, 80% дохода компании прино сят 20% ее клиентов. В реальных условиях это не так уж далеко от истины.

Создавая отчет для руководства компании, разумно включить в него дан ные о 5 10 лучших заказчиках.

Чтобы отобразить заданное число наибольших (наименьших) элементов по ля сводной таблицы с помощью пользовательского интерфейса Excel, щелкните на кнопке Дополнительно (Advanced) диалогового окна Вычисление поля сводной таблицы (PivotTable Field). Установите переключатель Включено (On), выберите из раскрывающегося списка Отображать (Show) значение Наибольших (Top), установите значение расположенного справа от списка Отображать счетчика равным 6 и выберите из раскрывающегося списка С помощью поля (Using field) значение Сумма по полю Выручка (Sum of Вы ручка), как показано на рис. 12.34.

Рис. 12.34. Функция Автоотображение лучшей десятки (Top 10 AutoShow) позволяет отобразить заданное число наи больших (наименьших) элементов поля сводной таблицы На заметку Название функции Автоотображение лучшей десятки (Top 10 AutoShow) может ввести в заблуждение. На самом деле, Excel позволяет отобразить заданное число (от 1 до 500) как наибольших, так и наименьших значений поля сводной таблицы.

Чтобы отобразить 6 наибольших элементов поля Заказчик с расчетом по полю Общая выручка в VBA, воспользуйтесь методом AutoShow:

' Вывести 6 лучших заказчиков.

PT.PivotFields("Заказчик").AutoShow Type:=xlAutomatic, _ Range:=xlTop, Count:=6, Field:="Общая выручка" Вызвав метод AutoShow и пересчитав сводную таблицу, рекомендуется скопировать полученный отчет, после чего вернуться к исходной сводной таблице, чтобы подсчитать значение поля Общая выручка для всех заказ чиков. В приведенном ниже коде это достигается путем удаления поля Заказчик из сводной таблицы, ее пересчета и копирования в отчет получен ной итоговой строки.

Sub Top6CEOReport() ' Этот макрос создает отчет о 6 лучших заказчиках ' с полями "Общая прибыль", "Валовая прибыль" и ' "Валовая прибыль, %".

Dim WSD As Worksheet Dim WSR As Worksheet Dim WBN As Workbook Dim PTCache As PivotCache Dim PT As PivotTable Dim PRange As Range Set WSD = Worksheets("Данные") 342 Часть II Автоматизация Excel ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк и области столбцов.

PT.AddFields RowFields:="Заказчик", ColumnFields:="Данные" ' Определить вычисляемые поля.

PT.CalculatedFields.Add Name:="ВаловаяПрибыль_%", _ Formula:="=Прибыль/Выручка" ' Определить поля области данных.

With PT.PivotFields("Выручка") With PT.PivotFields("Прибыль") With PT.PivotFields("ВаловаяПрибыль_%") ' Отсортировать поле "Заказчик" по убыванию, ' используя значение поля "Общая выручка".

PT.PivotFields("Заказчик").AutoSort Order:=xlDescending, _ Field:="Общая выручка" ' Отобразить 6 наибольших значений поля "Заказчик" ' с расчетом по полю "Общая выручка".

PT.PivotFields("Заказчик").AutoShow Type:=xlAutomatic, _ Range:=xlTop, Count:=6, Field:="Общая выручка" ' Заполнить нулями пустые ячейки в области данных.

PT.NullString = "0" ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True ' Создать новую рабочую книгу ' с одним рабочим листом.

Set WBN = Workbooks.Add(xlWBATWorksheet) Set WSR = WBN.Worksheets(1) WSR.Name = "Отчет" ' Создать заголовок отчета.

With WSR.[A1].Value = "6 лучших заказчиков" ' Скопировать диапазон ячеек TableRange2.Offset(1, 0) ' в рабочий лист "Отчет" новой рабочей книги.

PT.TableRange2.Offset(1, 0).Copy WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats LastRow = WSR.Cells(65536, 1).End(xlUp).Row WSR.Cells(LastRow, 1).Value = "Всего (по 6 заказчикам)" ' Подсчитать значение поля "Общая выручка" для всех заказчиков.

PT.PivotFields("Заказчик").Orientation = xlHidden PT.ManualUpdate = False PT.ManualUpdate = True PT.TableRange2.Offset(2, 0).Copy WSR.Cells(LastRow + 2, 1).PasteSpecial Paste:= _ xlPasteValuesAndNumberFormats WSR.Cells(LastRow + 2, 1).Value = "Всего (по всем заказчикам)" ' Удалить сводную таблицу и объект PivotCache.

PT.TableRange2.Clear Set PTCache = Nothing ' Применить стилевое форматирование:

' - выделить заголовки столбцов полужирным шрифтом;

' - выровнять заголовки столбцов по правому краю;

' - выполнить автоподбор ширины столбцов отчета.

Range("A3").EntireRow.Font.Bold = True Range("A3").EntireRow.HorizontalAlignment = xlRight Range("A3").HorizontalAlignment = xlLeft Range("B3").Value = "Общая выручка" WSR.Range(WSR.Range("A2"), WSR.Cells(LastRow + 2, 4)).Columns.AutoFit Range("A2").Select MsgBox "Отчет для руководства компании успешно создан" End Sub Результат выполнения макроса Top6CEOReport показан на рис. 12.35.

344 Часть II Автоматизация Excel Рис. 12.35. Отчет о 6 лучших заказчиках компании создан на основе двух Обратите внимание, что отчет о 6 лучших заказчиках компании был создан на основе двух сводных таблиц которая позволила получить список 6 лучших заказчиков, и таблицы без полей в области строк, которая использовалась для подсчета итоговой выручки.

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

Чтобы добиться аналогичного результата в VBA, следует установить значе ние свойства диапазона ячеек ShowDetail равным True, как показано ниже:

PT.TableRange2.Offset(2, 1).Resize(1, 1).ShowDetail = True Следующий макрос создает сводную таблицу, содержащую сведения об общей выручке, приходящейся на трех лучших заказчиков. Подробная ин формация обо всех сделках каждого заказчика выводится на отдельном рабо чем листе. Похожая задача рассматривалась в практикуме ‘‘Использование двух расширенных фильтров для создания отчетов по каждому заказчику’’ на с. 293, где для ее решения предлагалось использовать расширенный фильтр.

Sub RetrieveTop3CustomerDetail() Dim PTCache As PivotCache Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк и области столбцов.

PT.AddFields RowFields:="Заказчик", ColumnFields:="Данные" ' Определить поля области данных.

With PT.PivotFields("Выручка").Orientation = xlDataField.NumberFormat = "#,##0,K".Name = "Общая выручка" ' Отсортировать поле "Заказчик" по убыванию, ' используя значение поля "Общая выручка".

PT.PivotFields("Заказчик").AutoSort Order:=xlDescending, _ Field:="Общая выручка" ' Отобразить 3 наибольших значения поля "Заказчик" ' с расчетом по полю "Общая выручка".

PT.PivotFields("Заказчик").AutoShow Type:=xlAutomatic, _ Range:=xlTop, Count:=3, Field:="Общая выручка" ' Заполнить нулями пустые ячейки в области данных.

PT.NullString = "0" ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True ' Создать отчеты о сделках каждого заказчика.

PT.TableRange2.Offset(i + 1, 1).Resize(1, 1).ShowDetail = True Range("A1:A2").EntireRow.Insert Range("A1").Value = "Информация о сделках с заказчиком " _ & PT.TableRange2.Offset(i + 1, 0).Resize(1, 1).Value & " _ (порядковый номер в списке лучших заказчиков: " & i & ")" MsgBox "Отчеты о сделках с 3-мя лучшими заказчиками _ успешно созданы" End Sub 346 Часть II Автоматизация Excel Отчет о сделках самого крупного заказчика, полученный в результате вы полнения макроса RetrieveTop3CustomerDetail, показан на рис. 12.36.

Рис. 12.36. В результате выполнения макроса была создана сводная таблица, со держащая сведения о 3 х лучших заказчиках, а также подробные отчеты о сделках Использование полей области страницы сводной таблицы В добавок к полям в области строк, области столбцов и области данных, сводная таблица может содержать одно или несколько полей в области стра ницы. Поля области страницы выводятся в строках, расположенных над отче том сводной таблицы. Они могут использоваться для фильтрации отчета по различным критериям, например, по товару, региону или комбинации товара и региона. На рис. 12.37 показана сводная таблица, отображающая 10 лучших заказчиков товара ABC в западном регионе.

Чтобы определить поле области страницы в VBA, воспользуйтесь парамет ром PageFields метода AddFields. Следующий код определяет сводную таблицу с полем Регион в области страницы:

PT.AddFields RowFields:="Заказчик", ColumnFields:="Данные", _ PageFields:="Регион" По умолчанию значение поля области страницы Регион устанавливается равным (Все) ((All)). Чтобы ограничиться данными только по какому либо определенному региону (например, западному), воспользуйтесь свойством CurrentPage объекта PivotField:

PT.PivotFields("Регион").CurrentPage = "Запад" Рис. 12.37. Область страницы сводной таблицы содержит по ля Регион и Товар, которые могут использоваться для фильтрации отчета по товару, региону или их комбинации Поля области страницы часто применяются при создании пользователь ской формы, позволяющей выбрать требуемый регион или товар. Присвоив выбранное значение свойству CurrentPage, можно быстро получить требуе мый отчет.

Другое применение поля области страницы заключается в создании отче тов для всех значений этого поля. К примеру, чтобы определить общее число регионов, воспользуйтесь свойством Count объекта PivotItems:

PT.PivotFields("Регион").PivotItems.Count Ниже приведено два равноценных цикла по всем значениям поля Регион:

For i = 1 To PT.PivotFields("Регион").PivotItems.Count PT.PivotFields("Регион").CurrentPage = _ PT.PivotFields("Регион").PivotItems(i).Name PT.ManualUpdate = False PT.ManualUpdate = True Next i For Each PivItem In PT.PivotFields("Регион").PivotItems PT.PivotFields("Регион").CurrentPage = PivItem.Name PT.ManualUpdate = False PT.ManualUpdate = True Next PivItem Конечно же, поочередный вывод отчетов на экран имеет немного практи ческого смысла. Обычно отчет создается для его последующего сохранения.

Ранее в этой главе для копирования содержимого сводной таблицы при менялось свойство TableRange2 объекта PivotTable. Свойство TableRange2 ссылается на все строки сводной таблицы, включая строки полей об ласти страницы. Чтобы исключить строки полей области страницы, восполь зуйтесь свойством TableRange1 объекта PivotTable. Следующие строки ссылаются на одинаковый диапазон ячеек рабочего листа, показанного на рис. 12.37:

348 Часть II Автоматизация Excel PT.TableRange2.Offset(4, 0) PT.TableRange1.Offset(1, 0) Выбор того или иного свойства дело личного предпочтения. Тем не ме нее, свойство TableRange2 имеет некоторое преимущество, так как вызов метода TableRange2.Clear позволяет удалить сводную таблицу с рабочего листа. А вот попытка вызова метода TableRange1.Clear неминуемо завер шится выводом сообщения об ошибке времени выполнения 1004, напоми нающего о невозможности перемещения или изменения части сводной таб лицы Excel.

Следующий макрос создает отчеты о 10 лучших заказчиках в каждом из регионов. Каждый отчет помещается в новую рабочую книгу.

Sub Top10ByRegionReport() ' Этот макрос создает отчет о 10 лучших ' заказчиках в каждом из регионов.

Dim PTCache As PivotCache Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк, области ' столбцов и области страницы.

PT.AddFields RowFields:="Заказчик", ColumnFields:="Данные", _ PageFields:="Регион" ' Определить вычисляемые поля.

PT.CalculatedFields.Add Name:="ВаловаяПрибыль_%", _ Formula:="=Прибыль/Выручка" ' Определить поля области данных.

With PT.PivotFields("Выручка").Name = "Общая выручка" With PT.PivotFields("Прибыль").Orientation = xlDataField.NumberFormat = "#,##0,K".Name = "Валовая прибыль" With PT.PivotFields("ВаловаяПрибыль_%").Orientation = xlDataField.NumberFormat = "#0.0%".Name = "Валовая прибыль, %" ' Отсортировать поле "Заказчик" по убыванию, ' используя значение поля "Общая выручка".

PT.PivotFields("Заказчик").AutoSort Order:=xlDescending, _ Field:="Общая выручка" ' Отобразить 10 наибольших значений поля "Заказчик" ' с расчетом по полю "Общая выручка".

PT.PivotFields("Заказчик").AutoShow Type:=xlAutomatic, _ Range:=xlTop, Count:=10, Field:="Общая выручка" ' Заполнить нулями пустые ячейки в области данных.

PT.NullString = "0" ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True ' Создать цикл по всем значениям поля "Регион".

For Each PivItem In PT.PivotFields("Регион").PivotItems PT.PivotFields("Регион").CurrentPage = PivItem.Name PT.ManualUpdate = False PT.ManualUpdate = True ' Создать новую рабочую книгу с одним рабочим листом.

Set WBN = Workbooks.Add(xlWBATWorksheet) Set WSR = WBN.Worksheets(1) WSR.Name = PivItem.Name ' Создать заголовок отчета.

PivItem.Name ' Скопировать диапазон ячеек TableRange2.Offset(3, 0) ' в рабочий лист новой рабочей книги.

PT.TableRange2.Offset(3, 0).Copy WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats 350 Часть II Автоматизация Excel LastRow = WSR.Cells(65536, 1).End(xlUp).Row WSR.Cells(LastRow, 1).Value = "Всего ( _ по 10 лучшим заказчикам)" ' Применить стилевое форматирование:

' - выделить заголовки столбцов полужирным шрифтом;

' - выровнять заголовки столбцов по правому краю;

' - выполнить автоподбор ширины столбцов отчета.

Range("A3").EntireRow.Font.Bold = True Range("A3").EntireRow.HorizontalAlignment = xlRight Range("A3").HorizontalAlignment = xlLeft Range("B3").Value = "Выручка" WSR.Range(WSR.Range("A3"), WSR.Cells( _ LastRow, 4)).Columns.AutoFit ' Удалить сводную таблицу и объект PivotCache.

PT.TableRange2.Clear MsgBox Ctr & " отчета о лучших заказчиках в регионах _ успешно созданы" Отчеты, созданные в результате выполнения макроса Top10ByRegionReport, показаны на рис. 12.38.

Рис. 12.38. Отчеты о 10 лучших заказчиках в каждом регионе созданы с помощью цикла по всем значениям поля Регион Фильтрация элементов полей сводной таблицы вручную Вдобавок к созданию вычисляемых элементов, Excel позволяет фильтро вать элементы полей сводной таблицы вручную.

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

PT.PivotFields("Магазин").PivotItems("Миннеаполис").Visible = False Присвоение значения False свойству Visible всех элементов поля при ведет к возникновению ошибки времени выполнения. К примеру, на 1 й ите рации цикла макрос может отобразить товары A и B, а на 2 й итерации то вары C и D. Если скрыть товары A и B до того, как будут отображены това ры C и D, возникнет ошибка. Чтобы избежать подобного недоразумения, присвойте значение True свойству Visible всех элементов поля перед его фильтрацией.

Создадим отчет, включающий информацию о выручке, прибыли и валовой прибыли (%) от продаж товаров ABC и DEF по регионам.

Чтобы создать такой отчет с помощью пользовательского интерфейса Excel, необходимо выполнить следующие действия.

1. Создать сводную таблицу с полем Регион в области строк, полем Товар в области столбцов и полем Выручка в области данных.

2. Вручную отфильтровать поле Товар, скрыв все элементы за исключе 3. Переместить поле Товар из области столбцов в область страницы.

4. Поместить поля Прибыль и ВаловаяПрибыль_% (вычисляемое поле) в область данных.

Сводная таблица, полученная в результате выполнения указанных выше действий, показана на рис. 12.39.

Рис. 12.39. Элемент XYZ поля Товар скрыт, однако об Узнать о том, что элемент XYZ поля Товар скрыт, позволяет лишь раскры вающийся список, расположенный справа от названия поля Товар (рис. 12.40).

Создание подобного отчета рекомендуется автоматизировать с помощью VBA. Это позволит не только добавить заголовок и стилевое форматирование, 352 Часть II Автоматизация Excel но и поместить поле Товар непосредственно в область страницы, отфильтро вав нужные элементы с помощью свойства Visible.

Рис. 12.40. Факт фильтрации поля Товар обнаруживается Ниже приведен полный код макроса, создающего отчет о продажах товаров ABC и DEF по регионам.

Sub ProduceReportOfTwoProducts() ' Этот макрос создает отчет о продажах ' товаров ABC и DEF в регионах.

Dim PTCache As PivotCache Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк и области столбцов.

PT.AddFields RowFields:="Регион", ColumnFields:=Array( _ "Данные", "Товар") ' Определить вычисляемые поля.

PT.CalculatedFields.Add Name:="ВаловаяПрибыль_%", _ Formula:="=Прибыль/Выручка" ' Определить поля области данных.

With PT.PivotFields("Выручка").Orientation = xlDataField.NumberFormat = "#,##0,K".Name = "Общая выручка" ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True ' Убедиться, что поле "Товар" не содержит скрытых элементов.

For Each PivItem In PT.PivotFields("Товар").PivotItems PivItem.Visible = True Next PivItem ' Отфильтровать поле "Товар".

For Each PivItem In PT.PivotFields("Товар").PivotItems Select Case PivItem.Name Next PivItem ' Переместить поле "Товар" в область страницы.

PT.PivotFields("Товар").Orientation = xlPageField ' Добавить оставшиеся поля области данных.

With PT.PivotFields("Прибыль").Orientation = xlDataField.NumberFormat = "#,##0,K".Name = "Валовая прибыль" With PT.PivotFields("ВаловаяПрибыль_%").Orientation = xlDataField.NumberFormat = "#0.0%".Name = "Валовая прибыль, %" ' Заполнить нулями пустые ячейки в области данных.

PT.NullString = "0" ' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True 354 Часть II Автоматизация Excel ' Создать новую рабочую книгу с одним рабочим листом.

Set WBN = Workbooks.Add(xlWBATWorksheet) Set WSR = WBN.Worksheets(1) ' Создать заголовок отчета.

.Value = "Продажи по регионам - только товары ABC и DEF" ' Скопировать диапазон ячеек TableRange2.Offset(3, 0) ' в рабочий лист новой рабочей книги.

PT.TableRange2.Offset(3, 0).Copy WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats LastRow = WSR.Cells(65536, 1).End(xlUp).Row WSR.Cells(LastRow, 1).Value = "Всего (по товарам ABC и DEF)" ' Применить стилевое форматирование:

' - выделить заголовки столбцов полужирным шрифтом;

' - выровнять заголовки столбцов по правому краю;

' - выполнить автоподбор ширины столбцов отчета.

Range("A3").EntireRow.Font.Bold = True Range("A3").EntireRow.HorizontalAlignment = xlRight Range("A3").HorizontalAlignment = xlLeft Range("B3").Value = "Выручка" WSR.Range(WSR.Range("A3"), WSR.Cells(LastRow, _ 4)).Columns.AutoFit Range("A2").Select ' Удалить сводную таблицу и объект PivotCache.

PT.TableRange2.Clear MsgBox "Отчет о продажах товаров ABC и DEF успешно создан" Результат выполнения макроса ProduceReportOfTwoProducts показан на рис. 12.41.

Рис. 12.41. VBA позволяет гарантировать отсутствие ошибки времени выполнения и упростить создание отчета о продажах товаров ABC и DEF Сумма, среднее, количество, минимум, максимум и др.

Единственной статистикой, подсчитываемой для поля сводной таблицы ранее в этой главе, была сумма значений элементов поля. Помимо суммы, Ex cel позволяет вычислить среднее значение всех элементов поля, минимальное, максимальное значения и т.п. Чтобы подсчитать требуемую статистику в VBA, создайте поле области данных с уникальным именем и установите соответст вующее значение свойства xlFunction. Следующий макрос демонстрирует пример вычисления 5 ти различных статистик для поля Выручка по каждому заказчику.

Sub ReportManyDetailsByCustomer() ' Макрос, вычисляющий общую сумму выручки, количество ' заказов, среднюю выручку, минимальный и максимальный ' заказ для каждого клиента.

Dim WSD As Worksheet Dim PTCache As PivotCache Dim PT As PivotTable Dim PRange As Range Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables PT.TableRange2.Clear ' Задать диапазон исходных данных и создать ' объект кэша сводных таблиц.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) Set PTCache = ActiveWorkbook.PivotCaches.Add( _ SourceType:=xlDatabase, SourceData:=PRange.Address) Set PT = PTCache.CreatePivotTable(TableDestination:= _ WSD.Range("J2"), TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк и области столбцов.

PT.AddFields RowFields:="Заказчик", ColumnFields:="Данные" ' Определить поля области данных.

With PT.PivotFields("Выручка").Orientation = xlDataField.NumberFormat = "#,##0,K".Name = "Общая выручка" With PT.PivotFields("Выручка").Orientation = xlDataField.Function = xlCount 356 Часть II Автоматизация Excel With PT.PivotFields("Выручка") With PT.PivotFields("Выручка") With PT.PivotFields("Выручка") ' Заполнить нулями пустые ячейки в области данных.

' Пересчитать сводную таблицу.

PT.ManualUpdate = False PT.ManualUpdate = True Результат выполнения макроса ReportManyDetailsByCustomer пока зан на рис. 12.42.

Дополнительные вычисления в полях области данных сводной таблицы Excel позволяет проводить так называемые дополнительные вычисления в полях области данных сводной таблицы. В частности, значения элементов по ля можно отображать в виде доли от общей суммы, доли от суммы по строке, доли от суммы по столбцу или в виде разницы по отношению к значению другого элемента (рис. 12.43).

Рис. 12.42. Каждое поле области данных сводной таблицы содержит различную статисти ку поля Выручка (слева направо): общая сумма выручки, количество заказов, средняя сумма выручки, минимальная сумма заказа, максимальная сумма заказа Рис. 12.43. Excel предлагает разнообразные способы проведения дополнительных вычислений в полях 358 Часть II Автоматизация Excel В VBA вид дополнительного вычисления определяется с помощью свойст ва Calculation объекта PivotField, которое может принимать следующие значения: xlPercentOf, xlPercentOfColumn, xlPercentOfRow, xlPercentOfTotal, xlRunningTotal, xlPercentDifferenceFrom, xlDifferenceFrom, xlIndex и xlNoAdditionalCalculation. Некоторые ти пы вычислений требуют указания базового поля (свойство BaseField объек та PivotField) или комбинации базового поля и базового элемента (свойство BaseItem объекта PivotField). Более подробно дополнительные вычисления в полях области данных сводной таблицы рассматриваются в сле дующих разделах этой главы.

Доля от общей суммы Чтобы отобразить значения элементов поля в виде доли от общей суммы по этому полю, установите значение свойства Calculation равным xlPercentOfTotal, как показано ниже:

' Подсчитать долю от общей суммы.

With PT.PivotFields("Выручка").Orientation = xlDataField.Caption = "Доля от общей суммы".NumberFormat = "#0.0%".Calculation = xlPercentOfTotal Приведенное отличие от значения предыдущего элемента поля Сгруппировав даты поля ДатаОтгрузки по месяцам, можно составить от чет о процентном изменении выручки относительно предыдущего месяца.

Для этого установите значение параметра Calculation равным xlPercentDifferenceFrom, параметра BaseField — ДатаОтгрузки, а пара метра BaseItem — (назад) ((previous)).

' Подсчитать процентное отличие от предыдущего месяца.

With PT.PivotFields("Выручка").Orientation = xlDataField.Calculation = xlPercentDifferenceFrom.BaseField = "ДатаОтгрузки".BaseItem = "(назад)".NumberFormat = "#0.0%" Одно из наиболее существенных ограничений, касающееся вычислений, содержащих позиционные ссылки, заключается в невозможности использо вания методов AutoSort и AutoShow. В частности, это не позволяет срав нить общий объем закупок товаров заказчиками, предварительно отсортиро вав поле Заказчик по убыванию с помощью поля Общая выручка.

Приведенное отличие от значения заданного элемента поля Предположим, что компания предлагает своим клиентам товары трех ка тегорий: аппаратное обеспечение, программное обеспечение и договора на обслуживание компьютерной техники. Менеджеры по продажам получили за дание увеличить выручку от продажи программного обеспечения и заключе ния договоров на обслуживание на 10% по сравнению с выручкой от продажи аппаратного обеспечения. Чтобы создать соответствующую сводную таблицу с помощью VBA, установите значение параметра Calculation равным xlPercentDifferenceFrom, как показано ниже:

' Подсчитать процентное отличие от выручки, полученной ' в результате продажи аппаратного обеспечения.

With PT.PivotFields("Выручка").Orientation = xlDataField.Function = xlSum.Caption = "Отличие (%) от продаж аппаратного обеспечения".Calculation = xlPercentDifferenceFrom.BaseField = "Товар".BaseItem = "Аппаратное обеспечение".Position =.NumberFormat = "#0.0%" End With Нарастающий итог Для вычисления нарастающего итога по полю сводной таблицы необходи мо указать базовое поле. В рассматриваемом примере таким полем является поле области строк сводной таблицы ДатаОтгрузки. Таким образом, чтобы вычислить нарастающий итог по полю Выручка, необходимо установить зна чение свойства BaseField равным ДатаОтгрузки, как показано ниже:

' Подсчитать нарастающий итог.

With PT.PivotFields("Выручка").Orientation = xlDataField.Function = xlSum.Caption = "Нарастающий итог".Calculation = xlRunningTotal.Position =.NumberFormat = "#,##0,K".BaseField = "ДатаОтгрузки" End With На рис. 12.44 показана сводная таблица с тремя полями области данных, полученными в результате описанных выше дополнительных вычислений, а именно: вычисления доли от общей суммы, приведенного отличия от значе ния предыдущего элемента поля и нарастающего итога.

360 Часть II Автоматизация Excel Рис. 12.44. Каждое из полей области данных сводной таблицы содержит различные вычисления на основе суммы по полю Выручка: собственно сумма по полю Выручка, доля от общей суммы по полю Выручка, при веденное отличие от значения предыдущего элемента поля Общая выручка и нарастающий итог по полю Общая выручка Создание сводных таблиц в Excel Впервые сводные таблицы были представлены в Excel 95. В Excel 97 реализация сводных таблиц была значительно улучшена, а в Excel 2000 — кардинальным об разом изменена за счет добавления объекта кэша сводных таблиц PivotCache.

Несмотря на то что Microsoft официально прекратила поддержку Excel 97 несколь ко лет назад, этим продуктом до сих пор пользуются все еще достаточно много компаний. Чтобы обеспечить совместимость кода VBA, созданного с помощью Ex cel 2003, с Excel 97, его придется изрядно переработать.

Для создания сводной таблицы в Excel 97 используется метод PivotTableWizard. Рассмотрим пример построения простой сводной таблицы, отображаю щей выручку от продажи товаров по регионам.

Sub PivotExcel97Compatible() ' Этот макрос полностью совместим с Excel 97.

Set WSD = Worksheets("Данные") ' Удалить существующие сводные таблицы.

For Each PT In WSD.PivotTables ' Задать диапазон исходных данных.

FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8) ' Создать сводную таблицу с помощью метода PivotTableWizard.

Set PT = WSD.PivotTableWizard(SourceType:=xlDatabase, _ SourceData:=PRange.Address, _ TableDestination:="R2C10", TableName:="PivotTable1") PT.ManualUpdate = True ' Определить поля области строк и области столбцов.

PT.AddFields RowFields:="Регион", ColumnFields:="Товар" ' Определить поля области данных.

With PT.PivotFields("Выручка").Orientation = xlDataField.NumberFormat = "#,##0,K" PT.ManualUpdate = False PT.ManualUpdate = True WSD.Select End Sub Следующий шаг Сводные таблицы чрезвычайно гибкое и мощное средство в арсенале пользователя Excel. В комбинации с VBA они предоставляют превосходный вычислительный механизм и основу для создания всевозможных отчетов.

В следующей главе рассматриваются распространенные задачи, встречающие ся при работе с Excel, и их решения с помощью VBA, предлагаемые опытными программистами со всех уголков мира.

Глава Excel Первый принцип удачного про граммиста состоит в том, чтобы ни когда не писать один и тот же код дважды. Второй принцип удачного программиста требует создавать код для каждой рутинной операции.

В настоящей главе рассматрива ются макросы, присланные опыт ными пользователями Excel со всего мира. Эти программы не только помогут сэкономить время, но и прольют свет на новые спосо Замечательные возможности бы решения наиболее распростра Excel VBA

Различные программисты при На закуску

держиваются различных подходов к Следующий шаг

созданию программного кода. На глядным подтверждением этого яв ляются приведенные в данной главе макросы.

Расширение возможностей Excel с помощью VBA VBA позволяет раскрыть возмож ности Excel, недоступные посредст вом пользовательского интерфейса.

В следующих разделах рассматрива ется использование VBA для реали зации условного форматирования с более чем тремя условиями, и рас ширенного фильтра с более чем дву мя условиями.

364 Часть II Автоматизация Excel Условное форматирование с более чем тремя условиями Макрос Worksheet_Change любезно предоставлен Расселом Гауфом (Russell Hauf), проживающим в Бивертоне, штат Орегон, США.

По сути, макрос Worksheet_Change дублирует функцию условного фор матирования Excel. Увеличение максимального числа условий достигается за счет наличия управляющего листа, содержащего 2 столбца допустимых значений ячеек (столбец A) и соответствующих индексов цвета заливки (столбец B).

Private Sub Worksheet_Change(ByVal Target As Range) ' Этот макрос реализует условное форматирование ' с более чем 3-мя условиями.

' Исходный диапазон может содержать более чем 1 ячейку, ' поскольку он задается как пересечение диапазонов Target ' и D:D. Благодаря этому макрос будет выполняться корректно ' при удалении содержимого нескольких ячеек столбца D или ' вводе значений нескольких ячеек столбца D в виде массива.

Set rng = Intersect(Target, Range("D:D")) ' Если содержимое ячейки отсутствует ' в диапазоне rngColors, ее заливка удаляется.

Application.WorksheetFunction.VLookup(cl.Value, _ ThisWorkbook.Sheets("УФ (управляющий лист)").Range("rngColors"), _ Расширенный фильтр с более чем двумя условиями Макрос MultiFilter любезно предоставлен Ричи Силлсом (Richie Sills), проживающим в Вустере, Англия. Ричи работает консультантом по налогам в аудиторской компании.

Стандартный расширенный фильтр Excel позволяет задавать не более двух условий. Следующий макрос позволяет обойти это ограничение.

Sub MultiFilter() ' Обратите внимание, что Ричи размещает комментарии после кода.

' Другими словами, комментарий на строке 20 относится к коду Dim rngTarget As Range, rng1 As Range, rng2 As Range, _ rngMyRange As Range Const Crit1 As String = "DEF, LLC" Const Crit2 As String = "FGH LTD."

Const Crit3 As String = "QRS INC."

' Критерии расширенного фильтра.

Application.ScreenUpdating = False With Worksheets("Расширенный фильтр").Rows(1).Insert.Range("A1").Value = "dummy" ' Создать заголовок "dummy".

Set rngTarget =.Range("A1:A" &.Cells(Rows.Count, _ 1).End(xlUp).Row) ' Задать исходный диапазон.

rngTarget.AutoFilter Field:=1, Criteria1:=Crit1, _ Operator:=xlOr, Criteria2:=Crit ' Применить стандартный расширенный фильтр с 2-мя критериями.

Set rng1 =.AutoFilter.Range.Offset(1, 0).Resize( _.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible) ' Создать диапазон ячеек, ссылающийся ' на результат применения расширенного фильтра.

rngTarget.AutoFilter ' Вернуться к исходным данным.

rngTarget.AutoFilter Field:=1, Criteria1:=Crit ' Применить стандартный расширенный фильтр с 3-м критерием.

Set rng2 =.AutoFilter.Range.Offset(1, 0).Resize( _.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible) ' Создать диапазон ячеек, ссылающийся ' на результат применения расширенного фильтра.

rngTarget.AutoFilter.Rows(1).Delete ' Удалить заголовок "dummy".

Set rngMyRange = Union(rng1, rng2) ' Объединить диапазоны ячеек rng1 и rng2.

rngMyRange.EntireRow.Copy Destination:=Worksheets( _ "РФ (результат)").Range("A2") ' Скопировать полученный результат в рабочий лист "РФ (результат)".

Worksheets("РФ (результат)").Select Application.ScreenUpdating = True MsgBox "Фильтр успешно применен" End Sub Файловые операции Макросы, приведенные в следующих разделах, используются для выпол нения различных файловых операций.

366 Часть II Автоматизация Excel Поиск файлов Макрос Srch и функция BrowseForFolderShell любезно предоставле ны Натаном П. Оливером (Nathan P. Oliver), проживающим в Миннеаполисе, штат Миннесота, США. Натан занимает должности финансового консультан та и разработчика приложений.

Следующий макрос проводит поиск файлов, в имени которых встречается заданная строка, в указанной папке и ее подпапках. По результатам поиска создается список, в котором для каждого найденного файла выводится ссылка на файл, размер файла и дата его последнего изменения.

Dim i As Long, z As Long, ws As Worksheet, y As Variant y = Application.InputBox("Пожалуйста, введите строку, _ встречающуюся в имени файла", "Ввод информации") If y = False And Not TypeName(y) = "String" Then Exit Sub Application.ScreenUpdating = False fLdr = BrowseForFolderShell With Application.FileSearch Set ws = ThisWorkbook.Worksheets.Add(Sheets(1)) ws.Name = "Результат поиска файлов" 1), Address:=.FoundFiles(i) ActiveWindow.DisplayHeadings = False.Value = [{"Ссылка на файл","Размер (Kb)","Дата _ последнего изменения"}].Font.Underline = xlUnderlineStyleSingle.[d1:iv1 ].EntireColumn.Hidden = True Range(.[a65536 ].End(3)(2), _.[a65536 ]).EntireRow.Hidden = True Range(.[a2 ],.[c65536 ]).Sort [a2 ], xlAscending, _ Header:=xlNo Application.ScreenUpdating = True 1: Application.DisplayAlerts = False Worksheets("Результат поиска файлов").Delete Application.DisplayAlerts = True End Sub Function BrowseForFolderShell() As String Dim objShell As Object, objFolder As Object Set objShell = CreateObject("Shell.Application") ' Расскомментируйте следующую строку, чтобы начать ' обзор папок с рабочего стола Windows.

'Set objFolder =objShell.BrowseForFolder(0,"Пожалуйста, _ выберите папку", 0, 0) ' Укажите папку, с которой нужно начать обзор.

Set objFolder = objShell.BrowseForFolder(0, "Пожалуйста, _ выберите папку", 0, "c:\") If (Not objFolder Is Nothing) Then If IsError(objFolder.Items.Item.Path) Then _ BrowseForFolderShell = CStr(objFolder): GoTo Here If Len(objFolder.Items.Item.Path) > 3 Then BrowseForFolderShell = objFolder.Items.Item.Path _ & Application.PathSeparator BrowseForFolderShell = objFolder.Items.Item.Path Else: Application.ScreenUpdating = True: End Here:

Set objFolder = Nothing: Set objShell = Nothing End Function Удаление рабочей книги после определенной даты Макрос Workbook_Open любезно предоставлен Томом Уртисом (Tom Ur tis), проживающим в Сан Франциско, штат Калифорния, США. Том глава консалтинговой компании Atlas Programming Management, расположенной в районе Залива.

Приведенный ниже макрос удаляет активную рабочую книгу после 31 декабря 2004 года.

368 Часть II Автоматизация Excel Файл рабочей книги не помещается в Корзину (Recycle Bin), а навсегда удаляется с компьютера.

Sub Workbook_Open() DestWB.Sheets(DestWB.Sheets.Count).Name = _ CurFile & ws.Index DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile OrigWB.Close SaveChanges:=False Application.DisplayAlerts = False DestWB.Sheets(1).Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Set DestWB = Nothing End Sub Фильтрация данных с последующим копированием полученного результата в отдельные рабочие листы Макрос Filter_NewSheet любезно предоставлен Деннисом Валентай ном (Dennis Wallentin), проживающим в Остерсунде, Швеция. Деннис дает советы, касающиеся использования Excel и VBA, на своем собственном Web сайте по адресу: www.xldennis.com.

374 Часть II Автоматизация Excel Следующий макрос фильтрует исходные данные (рис. 13.2) и копирует по лученные результаты в отдельные рабочие листы (рис. 13.3).

Рис. 13.2. Исходные данные Рис. 13.3. Результат применения Sub Filter_NewSheet() Dim wbBook As Workbook Dim wsSheet As Worksheet Dim rnStart As Range, rnData As Range Set wbBook = ThisWorkbook Set wsSheet = wbBook.Worksheets("Фильтр и копирование") With wsSheet 'Убедитесь, что 1-я строка содержит заголовки столбцов.

Set rnStart =.Range("A2") Set rnData =.Range(.Range("A2"),.Range("C65536").End(xlUp)) Application.ScreenUpdating = True 'Применение расширенного фильтра.

rnStart.AutoFilter Field:=1, Criteria1:="AA" & i 'Копирование результата фильтрации.

rnData.SpecialCells(xlCellTypeVisible).Copy 'Добавление нового рабочего листа.

Worksheets.Add Before:=wsSheet 'Присвоение имени новому рабочему листу.

ActiveSheet.Name = "AA" & i 'Вставка результата фильтрации 'в новый рабочий лист.

Range("A2").PasteSpecial xlPasteValues 'Вернуться к исходным данным.

rnStart.AutoFilter Field:= With Application 'Очистить буфер обмена.

.CutCopyMode = False.ScreenUpdating = False End With End Sub Экспорт данных в Word Макрос Export_Data_Word_Table также любезно предоставлен Денни сом Валентайном.

Следующий макрос экспортирует данные с рабочего листа Excel в доку мент Word. Поскольку используется раннее связывание, необходимо добавить ссылку (команда меню редактора Visual Basic Tools References (Сервис Ссылки)) на библиотеку Microsoft Word Object Library.

Sub Export_Data_Word_Table() Dim wdApp As Word.Application Dim wdDoc As Word.Document Dim wdCell As Word.Cell Dim i As Long Dim wbBook As Workbook Dim wsSheet As Worksheet Dim rnData As Range Dim vaData As Variant Set wbBook = ThisWorkbook Set wsSheet = wbBook.Worksheets("Экспорт в Word") With wsSheet Set rnData =.Range("A1:A10") End With 'Поместить данные из диапазона A1:A10 в одномерный массив Variant.

vaData = rnData.Value 'Создать объект Word.

Set wdApp = New Word.Application 'Документ Test.doc должен находиться в той же папке, 'что и рабочая книга.

Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\Test.doc") 'Импортировать данные в 1-й столбец 1-й таблицы.

For Each wdCell In wdDoc.Tables(1).Columns(1).Cells wdCell.Range.Text = vaData(i, 1) Next wdCell 'Сохранить и закрыть документ.

With wdDoc End With 376 Часть II Автоматизация Excel 'Завершить работу скрытой копии Microsoft Word.

wdApp.Quit 'Удалить внешние переменные из памяти.

Set wdDoc = Nothing Set wdApp = Nothing MsgBox "Данные были успешно экспортированы в документ Test.doc.", _ vbInformation Работа с примечаниями В большинстве случаев примечания ячеек Excel используются не достаточ но эффективно. Рассматриваемые в следующих разделах макросы помогут ис править это упущение.

Вывод примечаний Макрос ListComments любезно предоставлен Томми Майлзом.

Excel позволяет печатать примечания, однако не позволяет выводить ин формацию о рабочей книге и (или) рабочем листе, к которым относится то или иное примечание. Следующий макрос помещает примечания, имена их авторов и сведения о местоположении в новую рабочую книгу для последую щего просмотра, сохранения и (или) печати.

Sub ListComments() Application.ScreenUpdating = False Set wb = Workbooks.Add(xlWorksheet) For Each cmt In ws.Comments With wb.Sheets(1).Cells(cmtCount, 2) = cmt.Parent.Parent.Parent.Name.Cells(cmtCount, 3) = cmt.Parent.Parent.Name.Cells(cmtCount, 5) = CleanComment(cmt.author, _ cmt.Text) wb.Sheets(1).UsedRange.WrapText = False Application.ScreenUpdating = True Set ws = Nothing Set wb = Nothing End Sub Private Function CleanComment(author As String, _ cmt As String) As String Dim tmp As String tmp = Application.WorksheetFunction.Substitute(cmt, _ author & ":", "") tmp = Application.WorksheetFunction.Substitute(tmp, _ Chr(10), "") CleanComment = tmp End Function Результат выполнения макроса ListComments показан на рис. 13.4.

Рис. 13.4. Макрос ListComments позволяет получить исчерпывающую информацию о примечаниях Изменение размера области примечания Макрос CommentFitter1 любезно предоставлен Томом Уртисом.

Следующий макрос изменяет размер области примечания так, чтобы она вместила в себя весь текст примечания.

Sub CommentFitter1() Application.ScreenUpdating = False Dim x As Range, y As Long For Each x In Cells.SpecialCells(xlCellTypeComments) Select Case True Case Len(x.NoteText) 378 Часть II Автоматизация Excel Application.ScreenUpdating = True Результат выполнения макроса CommentFitter1 показан на рис. 13.5.

Рис. 13.5. Теперь область примечания включает в себя весь его текст Изменение размера области примечания с помощью центрирования Макрос CommentFitter2 также любезно предоставлен Томом Уртисом.

Следующий макрос изменяет размер области примечания путем центриро вания текста примечания.

Sub CommentFitter2() Application.ScreenUpdating = False Dim x As Range, y As Long For Each x In Cells.SpecialCells(xlCellTypeComments) msoScaleFromTopLeft msoScaleFromTopLeft Application.ScreenUpdating = True Результат выполнения макроса CommentFitter2 показан на рис. 13.6.

Рис. 13.6. Результат центрирования текста примечания Размещение диаграммы в примечании Макрос PlaceGraph любезно предоставлен Томом Уртисом.