Добрый день, всем! Для упрощения своей работы решил создать динамический чек лист(если можно так выразиться), но ни как не могу придумать алгоритм реализации. Суть в следующем... Есть сводная таблица с требованиями. Каждая строка отдельное требование (в одном столбце). Последующие столбцы, своего рода классификаторы (однозначное требование... "зеленое", "тонкое", "мое"... ) Через стандартный фильтр вручную фильтруем нужные нам значения и тем самым сужается список требований. Но есть один столбец в котором указан диапазон... Вида: "100 - 500" , "< 50", "Все", "300-700", "< 300" (набросал пример в приложении) И получается, для того что бы отфильтровать диапазон, например от 10 до 400... нужно пролистывать фильтр и выбирать все возможные варианты... "100-500" + "< 50" + "Все" + "< 300" + "300 - 700" и т.д. так как искомый диапазон так или иначе пересекает, то что забито в фильтре... Вариантов много и надо самому прикидывать пресекается ли твой диапазон с тем или иным чекбоксом в фильтре... тут велика вероятность ошибки (постоянно что то выпадает, либо не туда ткну мышкой и т.д.).
Смотрю в сторону VBA потому, что в дальнейшем планирую отсев отфильтрованного в отельную книгу...
Но честно скажу... соображений по реализации вообще ни каких. Если кто может подкинуть идею или может у кого есть какие реализации... Буду благодарен.
З.Ы. В приложении кода нет... не знаю с чего начать
Добрый день, всем! Для упрощения своей работы решил создать динамический чек лист(если можно так выразиться), но ни как не могу придумать алгоритм реализации. Суть в следующем... Есть сводная таблица с требованиями. Каждая строка отдельное требование (в одном столбце). Последующие столбцы, своего рода классификаторы (однозначное требование... "зеленое", "тонкое", "мое"... ) Через стандартный фильтр вручную фильтруем нужные нам значения и тем самым сужается список требований. Но есть один столбец в котором указан диапазон... Вида: "100 - 500" , "< 50", "Все", "300-700", "< 300" (набросал пример в приложении) И получается, для того что бы отфильтровать диапазон, например от 10 до 400... нужно пролистывать фильтр и выбирать все возможные варианты... "100-500" + "< 50" + "Все" + "< 300" + "300 - 700" и т.д. так как искомый диапазон так или иначе пересекает, то что забито в фильтре... Вариантов много и надо самому прикидывать пресекается ли твой диапазон с тем или иным чекбоксом в фильтре... тут велика вероятность ошибки (постоянно что то выпадает, либо не туда ткну мышкой и т.д.).
Смотрю в сторону VBA потому, что в дальнейшем планирую отсев отфильтрованного в отельную книгу...
Но честно скажу... соображений по реализации вообще ни каких. Если кто может подкинуть идею или может у кого есть какие реализации... Буду благодарен.
З.Ы. В приложении кода нет... не знаю с чего начать
Benos, не знаю, у кого как, но у нас счас ночь Ну и вам доброго дня! Файл 7Kb - и в архив? Зачем? Нарисуйте на отдельном листе, как вам видится результат. И не надо в архив!
Benos, не знаю, у кого как, но у нас счас ночь Ну и вам доброго дня! Файл 7Kb - и в архив? Зачем? Нарисуйте на отдельном листе, как вам видится результат. И не надо в архив!Michael_S
Michael_S, просто не думал, что тут кто-то ночью как и я сидит Собственно мозговой штурм родил такой подход... [vba]
Код
Sub FouDIN() Dim DinMIN As Integer Dim DinMAX As Integer Dim iRowArr() As String Dim iCell As Long Dim iRowNum As String Dim j As Integer
DinMIN = Cells(1, "C").Value ' Задаем минимальное значние для диапазона DinMAX = Cells(1, "D").Value ' Задамем максимальное значние для диапазона
For iCell = 3 To Sheets("Tab").Cells(Rows.Count, "B").End(xlUp).Row ' перебор строк 'Debug.Print Sheets("Tab").Cells(iCell, "B").Row iRowArr = Split(Cells(iCell, "B").Value, "&") ' каждую строку бью на массив -> получаю число из размерного ряда For j = LBound(iRowArr) To UBound(iRowArr) ' перебираю массив в поисках нужных значений 'Debug.Print iRowArr(j) If DinMIN = iRowArr(j) Then iRowNum = iRowNum & " " & iCell 'поиска нижнего порога выборки If DinMAX = iRowArr(j) Then iRowNum = iRowNum & " " & iCell 'поиска поиск верхнего порога выборки Next j
Next iCell ' получили строку с номерами строк, в которые попали в выборку Debug.Print iRowNum End Sub
[/vba] Коряво, но все что в голову пришло. Принцип следующий... 1. Ввел через разделитель все размеры из диапазона 2. Проверяю есть ли среди размеров минимальный (нижняя граница выборки), аналогично для верхней 3. Если есть совпадение, значит строка попадает под мой диапазон 4. Заношу номер строки в "массив"(строку), для дальнейшей копии ее...
Вижу три минуса (как минимум): 1. В таблице есть столбец с "какой-то чушью" - столбец с типоразмерами 2. Есть сомнения, что проверяя наличие минимум и максимум в размерном ряде - не будет ошибок с отбором 3. В итоговой строке(iRowNum) с номерами строк для копирования... есть повторы... но это наверное можно исключить проверкой...
З.Ы. Не нашел функции для добавления элемента в массив... поэтому решил реализовать для через строку.
Michael_S, просто не думал, что тут кто-то ночью как и я сидит Собственно мозговой штурм родил такой подход... [vba]
Код
Sub FouDIN() Dim DinMIN As Integer Dim DinMAX As Integer Dim iRowArr() As String Dim iCell As Long Dim iRowNum As String Dim j As Integer
DinMIN = Cells(1, "C").Value ' Задаем минимальное значние для диапазона DinMAX = Cells(1, "D").Value ' Задамем максимальное значние для диапазона
For iCell = 3 To Sheets("Tab").Cells(Rows.Count, "B").End(xlUp).Row ' перебор строк 'Debug.Print Sheets("Tab").Cells(iCell, "B").Row iRowArr = Split(Cells(iCell, "B").Value, "&") ' каждую строку бью на массив -> получаю число из размерного ряда For j = LBound(iRowArr) To UBound(iRowArr) ' перебираю массив в поисках нужных значений 'Debug.Print iRowArr(j) If DinMIN = iRowArr(j) Then iRowNum = iRowNum & " " & iCell 'поиска нижнего порога выборки If DinMAX = iRowArr(j) Then iRowNum = iRowNum & " " & iCell 'поиска поиск верхнего порога выборки Next j
Next iCell ' получили строку с номерами строк, в которые попали в выборку Debug.Print iRowNum End Sub
[/vba] Коряво, но все что в голову пришло. Принцип следующий... 1. Ввел через разделитель все размеры из диапазона 2. Проверяю есть ли среди размеров минимальный (нижняя граница выборки), аналогично для верхней 3. Если есть совпадение, значит строка попадает под мой диапазон 4. Заношу номер строки в "массив"(строку), для дальнейшей копии ее...
Вижу три минуса (как минимум): 1. В таблице есть столбец с "какой-то чушью" - столбец с типоразмерами 2. Есть сомнения, что проверяя наличие минимум и максимум в размерном ряде - не будет ошибок с отбором 3. В итоговой строке(iRowNum) с номерами строк для копирования... есть повторы... но это наверное можно исключить проверкой...
З.Ы. Не нашел функции для добавления элемента в массив... поэтому решил реализовать для через строку.Benos
Не совсем понятен принцип отбора. Например, если заданы значения мин=15 и макс=300, как в примере, то строка 100-500 удовлетворяет этому критерию? То есть диапазон полностью должен перекрывать критерий или частично? И, на мой взгляд, если уж делать доп. столбцы, то удачнее вариант на Лист1, а не на листе Tab. Тогда если ищем хотя бы частичное перекрытие диапазона и критерия, можно задать условие типа если мин_критерий меньше Max (столбец на лист1) и макс_критерий больше Min (столбец на лист1), то строка подходит
Не совсем понятен принцип отбора. Например, если заданы значения мин=15 и макс=300, как в примере, то строка 100-500 удовлетворяет этому критерию? То есть диапазон полностью должен перекрывать критерий или частично? И, на мой взгляд, если уж делать доп. столбцы, то удачнее вариант на Лист1, а не на листе Tab. Тогда если ищем хотя бы частичное перекрытие диапазона и критерия, можно задать условие типа если мин_критерий меньше Max (столбец на лист1) и макс_критерий больше Min (столбец на лист1), то строка подходитPelena
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
For iCell = 3 To Sheets("Tab1").Cells(Rows.Count, "B").End(xlUp).Row ' ïåðåáîð ñòðîê If DinMAX >= Sheets("Tab1").Cells(iCell, "B").Value And _ DinMIN <= Sheets("Tab1").Cells(iCell, "C").Value Then _ NumRow = NumRow & " " & iCell Next iCell Debug.Print NumRow End Sub
[/vba] То что надо
Цитата
если мин_критерий меньше Max (столбец на лист1) и макс_критерий больше Min (столбец на лист1), то строка подходит
Именно эту логику и не смог подобрать
Pelena, согласен.. сумбурно объяснил принцип отбора Вы как всегда правы... [vba]
Код
Sub FouDIN2() Dim DinMIN As Integer Dim DinMAX As Integer Dim iCell As Long Dim NumRow As String
For iCell = 3 To Sheets("Tab1").Cells(Rows.Count, "B").End(xlUp).Row ' ïåðåáîð ñòðîê If DinMAX >= Sheets("Tab1").Cells(iCell, "B").Value And _ DinMIN <= Sheets("Tab1").Cells(iCell, "C").Value Then _ NumRow = NumRow & " " & iCell Next iCell Debug.Print NumRow End Sub
[/vba] То что надо
Цитата
если мин_критерий меньше Max (столбец на лист1) и макс_критерий больше Min (столбец на лист1), то строка подходит
Set RNGS = ActiveWorkbook.Sheets("Tab1").AutoFilter.Range.Offset(1, 0).Resize(ActiveWorkbook.ActiveSheet.AutoFilter.Range.Rows.Count - 1, _ ActiveWorkbook.ActiveSheet.AutoFilter.Range.Columns.Count).Columns(1).SpecialCells(xlCellTypeVisible) For Each iSet In RNGS If DinMAX >= ActiveWorkbook.Sheets("Tab1").Cells(iSet.Row, "B").Value And _ DinMIN <= ActiveWorkbook.Sheets("Tab1").Cells(iSet.Row, "C").Value Then _ NumRow = NumRow & "-" & iSet.Row Next Debug.Print NumRow NumRowAr = Split(NumRow, "-") For i = 0 To UBound(NumRowAr) If NumRowAr(i) <> "" Then ActiveWorkbook.Sheets("Tab1").Cells(NumRowAr(i), "A").Interior.Color = vbGreen Debug.Print ActiveWorkbook.Sheets("Tab1").Cells(NumRowAr(i), "A").Value End If Next i ActiveWorkbook.Sheets("Tab1").Columns("A").AutoFilter Field:=1, Criteria1:=Array(NumRowAr), Operator:=xlFilterValues End Sub
[/vba] Для того, что бы скопировать отфильтрованные строки. Фильтрую первый столбец по значению (так как знаю номер строки, определяю значение и подставляю его в массив и затем в критерий в автофильтре) Но почему то фильтруется только первая строка? По выборке должно быть 2 строки (которые подсвечены Зеленым).
Добрый день, еще раз! Снова уперся в стену [vba]
Код
Sub FouDIN2() Dim DinMIN As Integer Dim DinMAX As Integer Dim iCell As Long Dim NumRow As String Dim NumRowAr() As String
Set RNGS = ActiveWorkbook.Sheets("Tab1").AutoFilter.Range.Offset(1, 0).Resize(ActiveWorkbook.ActiveSheet.AutoFilter.Range.Rows.Count - 1, _ ActiveWorkbook.ActiveSheet.AutoFilter.Range.Columns.Count).Columns(1).SpecialCells(xlCellTypeVisible) For Each iSet In RNGS If DinMAX >= ActiveWorkbook.Sheets("Tab1").Cells(iSet.Row, "B").Value And _ DinMIN <= ActiveWorkbook.Sheets("Tab1").Cells(iSet.Row, "C").Value Then _ NumRow = NumRow & "-" & iSet.Row Next Debug.Print NumRow NumRowAr = Split(NumRow, "-") For i = 0 To UBound(NumRowAr) If NumRowAr(i) <> "" Then ActiveWorkbook.Sheets("Tab1").Cells(NumRowAr(i), "A").Interior.Color = vbGreen Debug.Print ActiveWorkbook.Sheets("Tab1").Cells(NumRowAr(i), "A").Value End If Next i ActiveWorkbook.Sheets("Tab1").Columns("A").AutoFilter Field:=1, Criteria1:=Array(NumRowAr), Operator:=xlFilterValues End Sub
[/vba] Для того, что бы скопировать отфильтрованные строки. Фильтрую первый столбец по значению (так как знаю номер строки, определяю значение и подставляю его в массив и затем в критерий в автофильтре) Но почему то фильтруется только первая строка? По выборке должно быть 2 строки (которые подсвечены Зеленым).Benos
А ведь задачку вполне можно решить и на формулах, не прибегая к VBA. Например, можно воспользоваться идеями для решения задачи о пересечении интервалов дат, взятыми отсюда.
Мне там понравилось решение от MCH (см. в комментариях), от которого я и буду отталкиваться. Суть решения - в проверке значения формулы
Если значение формулы неотрицательное, то диапазоны пересекаются (в частном случае при =0 диапазоны касаются в точке). Следующая формула (для 3-й строки) будет возвращать значение ИСТИНА, если диапазоны пересекаются, и ЛОЖЬ - в противном случае:
Код
=МИН($C$1;C3)-МАКС($B$1;B3)>=0
Эту формулу можно протянуть вниз, распространив на все строки таблицы, после чего в автофильтре для столбца с этой формулой использовать значение ИСТИНА для отбора пересекающихся диапазонов.
А ведь задачку вполне можно решить и на формулах, не прибегая к VBA. Например, можно воспользоваться идеями для решения задачи о пересечении интервалов дат, взятыми отсюда.
Мне там понравилось решение от MCH (см. в комментариях), от которого я и буду отталкиваться. Суть решения - в проверке значения формулы
Если значение формулы неотрицательное, то диапазоны пересекаются (в частном случае при =0 диапазоны касаются в точке). Следующая формула (для 3-й строки) будет возвращать значение ИСТИНА, если диапазоны пересекаются, и ЛОЖЬ - в противном случае:
Код
=МИН($C$1;C3)-МАКС($B$1;B3)>=0
Эту формулу можно протянуть вниз, распространив на все строки таблицы, после чего в автофильтре для столбца с этой формулой использовать значение ИСТИНА для отбора пересекающихся диапазонов.Gustav
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
