Познавательное

Копирование и переупорядочивание подмножества столбцов исходного диапазона данных

  

Применяя расширенный фильтр для создания отчета, вы, вероятно, захотите включить в последний только некоторые столбцы исходного диапазона данных.
Возвратимся к форме frmReport, рассматривавшейся ранее в этой главе. Форма frmReport предназначается для создания отчета о сделках для выбранных пользователем заказчиков. Создание отчета осуществляется с помощью процедуры RunCustReport, которая принимает в качестве параметра имя заказчика. Предположим, что по определенным соображениям в отчет нужно включить только столбцы Дата, Количество, Товар и Выручка (в указанном порядке). Следующий код копирует соответствующие заголовки столбцов в первую строку области вставки результата применения расширенного фильтра. Метод AdvancedFilter отбирает строки, удовлетворяющие заданному условию, как показано на рис. 11.18.

Копирование и переупорядочивание подмножества столбцов исходного диапазона данных

Рис. 11.18. Содержимое рабочего листа после применения расширенного фильтра

После этого процедура RunCustReport копирует отобранные строки в новую рабочую книгу, добавляет заголовок отчета, итоговую строку и сохраняет рабочую книгу в файле с именем, совпадающим с названием соответствующей фирмы-заказчика. Пример отчета о сделках для заказчика CDE INC. показан на рис. 11.19.
Копирование и переупорядочивание подмножества столбцов исходного диапазона данных

Рис. 11.19. Отчет о сделках для заказчика CDE INC.

Sub RunCustReport(WhichCust As Variant)
Dim IRange As Range
Dim ORange As Range
Dim CRange As Range
Dim WBN As Workbook
Dim WSN As Worksheet
Dim WSO As Worksheet
Set WSO = ActiveSheet
'  Определение размера исходного диапазона данных.
FinalRow = 06113(65536,   1).End(xlUp).Row
NextCol = Cellsd,  2 55) .End(xlToLeft) .Column + 2
'  Определение условия отбора.
Cellsd,  NextCol) .Value = Range ("Dl")-Value
Cells(2,  NextCol).Value = WhichCust
Set CRange = Cellsd, NextCol). Resize (2 , 1)
' Определение целевого диапазона данных.
'  В целевой диапазон войдут столбцы С (Дата),
'  Е  (Количество),  В (Товар) и F (Выручка).
Cellsd,  NextCol + 2).Resized,  4) .Value = Array(Cells(
3), Cellsd,   5),  Cellsd,  2), Cellsd, 6))
Set ORange = Cellsd, NextCol + 2).Resized, 4)
'  Определение исходного диапазона данных.
Set IRange = Range ("Al11). Resize (FinalRow, NextCol - 2)
'  Применение расширенного фильтра для отбора строк,
'  удовлетворяющих заданному условию.
IRange.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=CRange,  CopyToRange:=0Range
'  Содержимое рабочего листа на текущий
' момент показано на рис. 11.18.
' Создание новой рабочей книги для размещения
'  результата применения расширенного фильтра.
Set WBN = Workbooks.Add(xlWBATWorksheet)
Set WSN = WBN.Worksheets(1)
'  Определение заголовка отчета.
WSN.Cellsd,   1) .Value = "Отчет о сделках для заказчика
& WhichCust
'  Копирование данных с текущего активного
' рабочего листа в новую рабочую книгу.
WSO.Cells(1, NextCol + 2).CurrentRegion.Copy
Destination:=WSN.Cells(3, 1)
TotalRow = WSN.Cells(65536,   1).End(xlUp).Row + 1
WSN.Cells(TotalRow,   1).Value = "Всего"
'  В англоязычной версии Excel:
' WSN.Cells (TotalRow, 2) .FormulaRlCl = "=SUM(R2C:R[-1]C) 11
' WSN.Cells(TotalRow,  4).FormulaRlCl = "=SUM(R2C:R[-1]C)"
WSN.Cells(TotalRow,  2).FormulaRlClLocal = "=СУММ(R2C:R[-1]С)
WSN.Cells(TotalRow,  4).FormulaRlClLocal = "=СУММ(R2C:R[-1]С)
Стилевое форматирование отчета.
WSN.Cells(3,   1).Resized,  4).Font.Bold = True
WSN. Cells (TotalRow,   1).Resized,   4).Font.Bold = True
WSN.Cellsd,   1).Font.Size = 18
WBN.SaveAs "C:" & WhichCust & 11 .xls
WBN.Close SaveChanges:=False
WSO.Select
' Очистить область вставки результата
'  применения расширенного фильтра.
Range("J1:Z1").EntireColumn.Clear
End Sub

Процедура RunCustReport — это простой, однако весьма эффективный способ создания отчетов, который может применить на практике любой пользователь Excel.

ПРАКТИКУM
Использование двух расширенных фильтров для создания отчетов по каждому заказчику
Рассмотрим итоговый макрос, применяющий два расширенных фильтра различного типа для создания отчетов по каждому заказчику.
1. Первый расширенный фильтр используется для создания списка заказчиков в столбце J. Параметр Unique метода AdvancedFilter имеет значение True,
а параметр CopyToRange содержит ссылку на ячейку J, содержащую заголовок столбца D.
' Первый расширенный фильтр - создание
'  списка заказчиков в столбце J.
' Определение целевого диапазона.
' Копирование заголовка столбца D в ячейку J.
Range("Dl").Copy Destination:=Cells(1, NextCol)
Set ORange = Cellsd, NextCol)
' Определение исходного диапазона данных.
Set IRange = Range("Al").Resize(FinalRow, NextCol - 2)
' Применение расширенного фильтра для отбора
' уникальных значений из столбца D.
IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:="", _
CopyToRange:=ORange, Unique:=True

2. Для каждого заказчика из списка выполняются действия, описанные в пп.3-7. Приведенный ниже код определяет размер списка заказчиков и реализует соответствующий цикл.
' Цикл по списку заказчиков.
FinalCust = Cells(65536,  NextCol).End(xlUp).Row
For Each cell In Cells(2, NextCol).Resize(FinalCust - 1, 1)
ThisCust = cell.Value
' Выполнение действий,  описанных в пп. 3-7.
Next Cell

3. Условие отбора второго расширенного фильтра содержится в ячейках Ll:L2
(заголовок столбца D в ячейке Ы, имя заказчика — в ячейке L2).
' Определение условия отбора.
Cellsd, NextCol + 2).Value = Range ("Dl") .Value
Cells(2, NextCol + 2).Value = ThisCust
Set CRange = Cellsd, NextCol + 2).Resize(2, 1)

4. Второй расширенный фильтр используется для копирования строк, удовлетворяющих заданному условию, в область, начинающуюся со столбца N. Параметр Unique метода AdvancedFilter имеет значение False, а параметр CopyToRange представляет собой ссылку на диапазон ячеек N1: Q1, содержащий заголовки необходимых столбцов исходного диапазона данных.
' Определение целевого диапазона данных.
' В целевой диапазон войдут столбцы С (Дата),
' Е (Количество),  В  (Товар)  и F (Выручка).
Cellsd, NextCol + 4).Resized,   4) .Value = Array (Cells (1, 3),
Cellsd,   5), Cellsd,  2), Cellsd, 6))
Set ORange = Cellsd, NextCol + 4).Resized, 4)
' Второй расширенный фильтр - отбор строк,
'  удовлетворяющих заданному условию.
IRange.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:=CRange, CopyToRange:=ORange

5. Результат применения второго расширенного фильтра копируется в новую рабочую книгу. Для создания рабочей книги используется метод workbooks .Add.
' Создание новой рабочей книги для размещения
' результата применения расширенного фильтра.
Set WBN = Workbooks.Add(xlWBATWorksheet)
Set WSN = WBN.Worksheets(1)
' Определение заголовка отчета.
WSN.Cells(l,   1) .Value = "Отчет о сделках заказчика  11 & ThisCust
' Копирование данных с текущего активного
' рабочего листа в новую рабочую книгу.
WSO.Cells(1, NextCol + 4).CurrentRegion.Copy _
Destination:=WSN.Cells(3, 1)

6. Последний штрих - добавление заголовка отчета и итоговой строки. Вдобавок, строка заголовков столбцов и итоговая строка выделяются полужирным
шрифтом.
' Определение заголовка отчета.
WSN.Cells(l,   1).Value = "Отчет о сделках заказчика & ThisCust"
TotalRow = WSN.Cells(6553 6,   1).End(xlUp).Row + 1
WSN.Cells(TotalRow,  1).Value = "Всего"
' В англоязычной версии Excel:
' WSN.Cells(TotalRow,  2).FormulaRlCl = "=SUM(R2C:R[-1]C)"
' WSN.Cells(TotalRow,  4).FormulaRlCl = "=SUM(R2C:R[-1]C)"
WSN.Cells(TotalRow,  2).FormulaRlClLocal = "=СУММ(R2C:R[-1]С
WSN.Cells(TotalRow,  4).FormulaRlClLocal = "=СУММ(R2C:R[-1]С
' Стилевое форматирование отчета.
WSN.Cells(3,   1).Resized,   4).Font.Bold = True
WSN. Cells (TotalRow,   1) .Resized,  4) .Font.Bold= True
WSN.Cellsd,   1).Font.Size = 18

7. Новая рабочая книга сохраняется в файле с именем, совпадающим с названием соответствующей фирмы-заказчика, после чего эта книга закрывается. Перед переходом к следующей итерации цикла макрос очищает область вставки результата выполнения обоих расширенных фильтров.
WBN.SaveAs  НС:И & ThisCust &   ".xls"
WBN.Close SaveChanges:=False
WSO.Select
Set WSN = Nothing
Set WBN = Nothing
' Очистить область вставки результата
'  применения расширенных фильтров.
Cellsd, NextCol + 2).Resized, 10).EntireColumn.Clear

Ниже приведен полный КОД макроса RunReportForEachCustomer.
Sub RunReportForEachCustomer()
Dim IRange As Range
Dim ORange As Range
Dim CRange As Range
Dim WBN As Workbook
Dim WSN As Worksheet
Dim WSO As Worksheet
Set WSO = ActiveSheet
'  Определение размера исходного диапазона данных.
FinalRow = Cells(65536,   1).End<xlUp).Row
NextCol = Cellsd,  255) .End(xlToLeft) .Column + 2
'  Первый расширенный фильтр - создание
'  списка заказчиков в столбце J.
'  Определение целевого диапазона.
'  Копирование заголовка столбца D в ячейку Л.
Range("Dl").Copy Destination:=Cells(1, NextCol)
Set ORange = Cellsd, NextCol)
'  Определение исходного диапазона данных.
Set IRange = Range("Al").Resize(FinalRow, NextCol - 2)
'  Применение расширенного фильтра для отбора
'  уникальных значений из столбца D.
IRange.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange : =11 11 ,  CopyToRange: =ORange,  Unique: =True
FinalCust = Cells(65536, NextCol) .End(xlUp) .Row
Цикл по списку заказчиков.
For Each cell In Cellsd NextCol) .Resize(FinalCust - 1, 1)
ThisCust = cell.Value
Определение условия отбора.
Cellsd, NextCol + 2).Value = Range ("Dl") .Value
Cells(2/ NextCol + 2).Value = ThisCust
Set CRange = Cellsd, NextCol + 2).Resize(2, 1)
Определение целевого диапазона данных.
В целевой диапазон войдут столбцы С (Дата),
Е  (Количество),  В (Товар)  и F (Выручка).
Cellsd, NextCol + 4).Resized,   4) .Value = _
Array (Cellsd,   3),  Cellsd,   5), Cellsd,   2),  Cellsd, 6))
Set ORange = Cellsd, NextCol + 4).Resized, 4)
'  Второй расширенный фильтр - отбор строк,
'  удовлетворяющих заданному условию.
IRange.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:=CRange,  CopyToRange:=ORange
'Создание новой рабочей книги для размещения езультата применения расширенного фильтра.
Set WBN = Workbooks.Add(xlWBATWorksheet)
Set WSN = WBN.Worksheets(1)
' Определение заголовка отчета.
WSN.Cellsd,   1).Value = "Отчет о сделках заказчика
& ThisCust
'  Копирование данных с текущего активного
'  рабочего листа в новую рабочую книгу.
WSO.Cellsd, NextCol + 4) .CurrentRegion.Copy _
Destination:=WSN.Cells(3,   1)
TotalRow = WSN.Cells(65536, 1).End(xlUp).Row + 1
WSN.Cells(TotalRow,   1).Value = "Всего"
'  В англоязычной версии Excel:
' WSN.Cells (TotalRow, 2). FormulaRlCl = 11 =SUM(R2C :R [ -1 ] С)
' WSN. Cells (TotalRow,  4). FormulaRlCl = 11 =SUM (R2C : R [ -1 ] С)
WSN.Cells(TotalRow,  2).FormulaRlClLocal = _
"=CyMM(R2C:R[-l]C)"
WSN.Cells(TotalRow,  4).FormulaRlClLocal = _
"=CyMM(R2C:R[-l]C)"
вое форматирование отчета.
WSN.Cells(3,   1).Resized,  4).Font.Bold = True
WSN.Cells (TotalRow,   1).Resized,   4).Font.Bold = True
WSN.Cellsd,   1).Font.Size = 18
WBN.SaveAs "C:" & ThisCust & ".xls"
WBN.Close SaveChanges:=False
WSO.Select
Set WSN = Nothing
Set WBN = Nothing
'  Очистить область вставки результата
'  применения расширенных фильтров.
Cellsd, NextCol + 2).Resized,   10) .EntireColumn. Clear
Next cell
Cellsd, NextCol) .EntireColumn.Clear
MsgBox FinalCust - 1 & " отчетов были успешно созданы!"
End Sub

Подведем итог. Комбинация двух расширенных фильтров позволила создать 27 отчетов менее чем за 1 минуту (рис. 11.20). С учетом того, что опытные пользователи Excel создают один отчет в среднем за 2-3 минуты, макрос RunReportForEachCustomer позволяет сэкономить ОКОЛО 1 часа рабочего времени.
Копирование и переупорядочивание подмножества столбцов исходного диапазона данных

Рис. 11.20. Создание 27 отчетов менее чем за одну минуту — весьма неплохой результат для комбинации двух расширенных фильтров!
 


Посетители, находящиеся в группе Гости, не могут оставлять комментарии к данной публикации.