Именно так называется очередное видео от Николая Павлова, размещенное на его сайте https://www.planetaexcel.ru. Полная ссылка https://www.planetaexcel.ru/techniques/12/18012/
https://www.planetaexcel.ru/techniques/12/18012/
Здесь имеется прекрасный разбор примера продаж по разным городам.
Основная суть. Есть таблица с некоторым ключевым полем. Через меню Умная таблица даем ей имя ТаблПродажи.
Копируем столбец с ключевым полем правее основной таблицы. Задаем ей имя через тот же пункт меню ТаблГорода.
Оставляем в этом столбце лишь уникальные записи. В 2016 Excel это делается также через меню.
Создаем макрос Splitter. Код его представлен. При запуске макроса происходит разноска данных одного листа за счет применения фильтрации и выборки на новые листы, которым присваивается имя обрабатываемого города.
Применённая технология может быть использована на различных данных, где на листе имеются совпадающие ключевые значения в одном или нескольких столбцах. Обычно их называют критерии. Это могут быть Criteria1, Criteria2 и т.д. Т.е. ключевых полей может быть и несколько как и столбцов основной таблицы, где мы и будем искать эти критерии(ключи) на совпадение.
В образовании такими ключами чаще всего выступают номер класса и его литера. Часто эти значения разделены по разным столбцам. Я предпочитал всегда разносить класс и его литеру по разным столбцам.
Во всяком случае я давно использовал этот метод разноски данных с одного листа по разным классам или школам.
Я до сих пор предпочитаю по старинке работать в Excel 2003. Возможности его ограничены по сравнению со старшими версиями. От этого даже становится интересно проверить 2003 версию на примерах 2016 версии. 2016 версия у меня стоит на другом ПК., который использует внучка.
Есть более универсальный метод выборки данных с применением механизма создания диапазона строка RowRange.
Обычно лист с данными для последующей выборки имеет несколько строк шапки сверху. А данные начинаются со строки 4, 5 или 6.
Поэтому вначале мы создаем диапазон, содержащий шапку, а затем к нему через оператор
Set RowRange = Union(RowRange, ActiveSheet.Rows(i)) добавляем найденные строки с нужными нам критериями.
Макрос формирует новый лист с выбранными по ключу данными и возвращает количество найденных записей Sum1.
Sub Wybor_Litera_Klass_List(Sum1)
‘Это ПодПрограмма выбора всех учащихся
‘всех классов
‘Каждый класс выбирается на свой лист
Dim i As Integer, k As Integer
Dim Klass1 As String
Dim Litera1 As String
Dim RowRange As Range
Dim iw As Integer
On Error GoTo Error_Handler
Sum1 = 0
Begin_Stroka = 6 ‘Начало данных с 6 строки
If ActiveSheet.Name <> “Список учащихся” Then
Sheets(“Список учащихся”).Activate
End If
‘Подсчет числа столбцов. Считаем не пустые столбцы
‘Можно воспользоваться и командой CurrentRegion
Columns_Kol = 0
For i = 1 To 256
If Cells(5, i) <> Empty Then Columns_Kol = Columns_Kol + 1
Next
‘Определяем ширину каждого столбца в исходном файле
For i = 1 To Columns_Kol
ActiveSheet.Columns(i).Select
Columns_Width(i) = ActiveSheet.Columns(i).ColumnWidth
Next
‘Ключи сравнения или критерии находятся во 2-ом и 3-ем столбцах
i = 6
Klass = ActiveSheet.Cells(i, 2).Value
Litera = ActiveSheet.Cells(i, 3).Value
Do While Klass <> Empty
k = 1
Klass1 = ActiveSheet.Cells(i, 2).Value
Litera1 = ActiveSheet.Cells(i, 3).Value
Do While Klass = Klass1 And Litera = Litera1
If k = 1 Then ‘Создаем диапазон строк, содержащих шапку в первых 5 строках
Set RowRange = ActiveSheet.Rows(1)
Set RowRange = Union(RowRange, ActiveSheet.Rows(2))
Set RowRange = Union(RowRange, ActiveSheet.Rows(3))
Set RowRange = Union(RowRange, ActiveSheet.Rows(4))
Set RowRange = Union(RowRange, ActiveSheet.Rows(5))
End If
‘Добавляем строки, отвечающин критериям выборки
Set RowRange = Union(RowRange, ActiveSheet.Rows(i))
‘Перенумерация всех учеников
‘ActiveSheet.Cells(i, 1) = k
k = k + 1
i = i + 1
Klass1 = ActiveSheet.Cells(i, 2).Value
Litera1 = ActiveSheet.Cells(i, 3).Value
If Klass1 = Empty Then Exit Do
If Klass1 <> Klass Or Litera1 <> Litera Then
Sum1 = Sum1 + k – 1
k = 1
RowRange.Select
Selection.Copy
Sheets.Add
ActiveSheet.Name = Klass + ” ” + Litera
Range(“A1”).Select
For iw = 1 To Columns_Kol
ActiveSheet.Columns(iw).ColumnWidth = Columns_Width(iw)
Next
ActiveSheet.Paste ‘Вставляем диапазон с шапкой и данными на добавленный ранее лист
Range(“A1”).Select
Sheets(“Список учащихся”).Select
Klass = Klass1
Litera = Litera1
End If
Loop
If Klass1 = Empty Then Exit Do
Loop
RowRange.Select
Selection.Copy
Sheets.Add
ActiveSheet.Name = Klass + ” ” + Litera
Range(“A1”).Select
”Настройка столбцов
For iw = 1 To Columns_Kol
ActiveSheet.Columns(iw).ColumnWidth = Columns_Width(iw)
Next
Sum1 = Sum1 + k – 1
ActiveSheet.Paste
Range(“A1”).Select
Sheets(“Список учащихся”).Select
Range(“A1”).Select
GoTo Exit1
Error_Handler:
MsgBox “Список учеников не отсортирован по классу” + vbCr + _
” Попытка сформировать лист ” + Klass + Litera
Resume Next
Exit1:
End Sub
Программа версия Excel 2003 по реализации предложенного метода Н.Павловым, но с учетом невозможности реализации функций 2016 версии.
Данные представляют из себя сведения об учениках одной из школ с убранными идентифицирующими сведениями: Фамилия, адрес, телефон. Шапка расположена в строках 1-5. Данные располагаются со строки 6. Запуск через auto_open с формой из трех команд.
На самом деле важность представляет лишь последняя команда и связанный с ней вызываемый модуль. Две предыдущие команды просто показывают последовательность реализации выборки учащихся по классам, – удаление всех листов кроме листа Данные, переход к столбцу критерии и собственно самой выборки.
Показ изменения данных на листах книги блокирован до завершения программы, как и вывод системных сообщений. Обработка листов показывается в строке статуса.