Страницы: 1
RSS
Фильтр всех заказов из диапазона со списком заказов, с дополнительными условиями фильтрации
 
Есть макрос, который был написан около года назад, с Вашей помощью, за что спасибо. А сейчас его полезности не хватает. Точнее нужно больше функций.
Сам макрос работает как автофильтр, который берет диапазон номеров заказов из одного листа и применяет его в фильтре другого листа, где ищет совпадения и выдает таблицу с отобранными заказами. После этого копирует все полученное в другой лист.
Сейчас надо добавить еще один фильтр в этот цикл. В таблице заказов кроме номера заказа теперь появляется еще одна переменная - номер детали в заказе. То есть нужно при фильтрации каждого заказа фильтровать еще и номера деталей. В каждом заказе количество деталей разное, от 1 до 50, и нужно выбирать всегда разные. При этом количество заказов может быть тоже от 1 до 100. В итого работа макроса должна иметь тот же вывод, что и сейчас, но еще и уметь выбирать номера деталей для каждого заказа.
В программировании VBA не силен, больше в Pithon работаю, поэтому не догоняю многих вещей из VBA. Думал добавить в оператор цикла for еще и while, чтобы работал так: взять из списка значений для фильтра первое и присвоить в автофильтр фильтруемого диапазона на другом листе; пока фильтруем текущее значение по номеру заказа, запускаем фильтр по номеру детали (номера деталей записаны на том же листе, где и номера заказов. В одной ячейке указаны номера через запятую. Ячейка с номерами деталей напротив ячейки с номерами заказов), полученный двойной автофильтр для первого заказа оставляем и переходим на следующий заказ (i+1) и повторяем те же действия. Полученный результат из всех фильтрованных заказов с деталями копируем в лист1.
Пример файла прикрепил, только там попыток изменить нету, так как ни одна не сработала я решил оставить только исходную рабочую версию макроса.
Мозгов не хватает как это дело сделать параллельным. Объяснение, конечно, тоже хромает.
Если эта тема уже была где-то на форуме, то буду очень не против ее прочесть, чтобы сделать задуманное, но пока подобное не получилось найти. Может плохо ищу)
 
У вас в таблице есть столбец "№ Детали" и "номер детали" по какому из них нужно фильтроваться? и где вы будете указывать какие детали фильтровать?
Желательно сделать вручную что хотите и результат в качестве примера.
 
Прикрепил таблицу с поправками. Добавил примечания и то, что хотим получить в результате работы макроса. Если что-то нужно еще добавить в таблицу, то обязательно сделаем.
 
victorSwild, а обязательно фильтр? можно же просто скрыть не нужные строки макросом и все...
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
pantel1987 написал: У вас в таблице есть столбец "№ Детали" и "номер детали" по какому из них нужно фильтроваться?
Да, тут ошибочно сделали шапку таблицы. Нужно только по столбцу Е: "№ Детали" фильтроваться. Залил нужные названия столбцов желтым, чтобы ориентироваться более точно. В последнем столбце я удалил название, чтобы не путаться. И, спасибо, что заметили, мы даже внимания не обращали на этот пункт.)

Цитата
Mershik написал: можно же просто скрыть не нужные строки макросом и все...
Очень хорошая мысль! Да, так тоже можно) Только все равно пока не понятно как к каждому заказу определенные номера деталей только оставлять.
 
victorSwild,сейчас попробую - как-то так получилось, жмите кнопку на листе2 "Автофильтр"
Код
Sub mrshkei()
Dim i As Long, n As Long, k As Long, arr, lr As Long, lr2 As Long, cell As Range, sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Set sh = Worksheets("Лист1"): Set sh2 = Worksheets("Лист2"): Set sh3 = Worksheets("Лист3")
Application.ScreenUpdating = False
sh2.UsedRange.EntireRow.Hidden = False
lr = sh3.Cells(Rows.Count, 1).End(xlUp).Row: lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
sh2.Rows("2:" & lr2).Hidden = True
For i = 1 To lr
    arr = Split(sh3.Cells(i, 7), ",")
    For k = LBound(arr) To UBound(arr)
        For n = 2 To lr2
            If sh3.Cells(i, 1) = sh2.Cells(n, 1) And sh2.Cells(n, 5) = CSng(arr(k)) Then
                If cell Is Nothing Then
                    Set cell = sh2.Cells(n, 1)
                Else
                    Set cell = Union(cell, sh2.Cells(n, 1))
                End If
            End If
        Next n
    Next k
Next i
If Not cell Is Nothing Then
    cell.EntireRow.Hidden = False
    sh.Range("A2:P" & sh.Cells(Rows.Count, 1).End(xlUp).Row + 2).Clear
    cell.EntireRow.Copy Destination:=sh.Range("A2")
End If
Application.ScreenUpdating = True
End Sub
Изменено: Mershik - 08.12.2020 09:44:53
Не бойтесь совершенства. Вам его не достичь.
 
Спасибо огромное!!! Все работает как дорогие швейцарские часы) Будем пробовать теперь дальше все совершенствовать.
Страницы: 1
Наверх