Формирование новых таблиц для каждой строки из одной таблицы по критерию - VB
Формулировка задачи:
Здравствуйте! Задача в следующем: в Excel имеется одна таблица, в которой есть столбцы двух уровней - это различные варианты и подварианты. В первом столбце номер элемента (ID), значения каждого элемента указываются в строках таблицы. Необходимо из этой таблицы для каждого элемента сформировать новую таблицу с одной строкой - элементом и столбцами вариантами и подвариантами, в которых значения отобраны по критерию (>220 например).
Пример в приложенном файле.
Может эту задачу можно решить и не используя VBA, буду рад любой помощи
Решение задачи: «Формирование новых таблиц для каждой строки из одной таблицы по критерию»
textual
Листинг программы
Option Explicit Sub Copy_Table_if() Dim RSy%, REy%, RSx%, REx% 'Read Dim WSy%, WCy%, WSx%, WCx% 'Write Dim X%, Y% 'cycle Dim Request$, FirstTime As Boolean 'определение границ таблицы (привязка к начальной ячейке B2) With [B2] RSy = .Row + 1 REy = .End(xlDown).Row 'Last Row RSx = .Column + 1 'Column "C" REx = .End(xlToRight).Column 'Last Column End With Request = Range("Criteria") 'Условие в именованной ячейке (Ctrl+F3) With Range("Result") 'Результат записывать, начиная с именованной ячейки "Result" WSy = .Row + 1 'Start WCy = WSy 'Current WSx = .Column + 1 'Start WCx = WSx 'Current End With For Y = RSy To REy For X = RSx To REx If Evaluate(Cells(Y, X).Value & Request) Then If Not FirstTime Then 'первое значение нашли - создаем таблицу FirstTime = True Cells(WCy, WCx).Offset(-1, -1).Value = "ID" Cells(WCy, WCx).Offset(0, -1).Value = Cells(Y, RSx - 1).Value End If Cells(WCy, WCx).Offset(-2, 0).Value = Cells(RSy, X).Offset(-2, 0).Value Cells(WCy, WCx).Offset(-1, 0).Value = Cells(RSy, X).Offset(-1, 0).Value Cells(WCy, WCx).Value = Cells(Y, X).Value WCx = WCx + 1 End If Next X 'Если были совпадения, делаем промежуток между таблицами результатов If FirstTime Then FirstTime = False: WCx = WSx: WCy = WCy + 4 Next Y End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д