VBA Выбор фильтрованных ячеек

У меня есть UserForm в листе. В этой форме у меня есть 6 combobox.

Это поле со списком заполняется из листа с шестью столбцами, каждый столбец переходит в поле со списком. После того, как выбрано каждое поле со списком, я делаю фильтр на этом листе и повторно заполняю следующий.

Я приведу вам пример, чтобы сделать его более понятным.

У меня есть лист с 6 столбцами:
Континент | Страна | Государство | Город | Улица | Название здания

У этого листа есть ВСЕ возможные комбинации для всего этого. Например: для каждого здания на улице у меня есть строка со всеми пятью первыми элементами, а последняя изменяется.

Когда пользователь открывает форму, я заполняю первое поле со списком с первым столбцом листа (я делаю процедуру для получения уникальных элементов). Когда пользователь меняет первое поле со списком, я применяю фильтр к листу в первом столбце, а затем заполняю второе поле со списком фильтров.

Моя проблема заключается в том, как получить отфильтрованный диапазон. Я делаю это:

lastRow = Листы («SIP»). Диапазон («A65536»). Конец (xlUp) .Row
lFiltered = Листы («SIP»). Диапазон («A2: F» и lastRow) .SpecialCells (xlCellTypeVisible) .Cells

Он работает нормально. Но когда я применяю фильтр, и он скрывает, например, только строка 10, переменная lFiltered вернется только до строки 9. Она разбивается на первую скрытую строку и после этого не возвращает ни одной строки.

Решение, которое я придумал, – это сделать foreach с каждой строкой и проверить, видимо ли это или нет, но код действительно, очень медленный. Чтобы заполнить каждое поле со списком, требуется до 10 секунд.

Кто-нибудь знает, как я могу обойти эту проблему?

Большое спасибо.

— редактировать —

Вот важная часть кода

Dim listaDados As New Collection Dim comboList() As String Dim currentValue As String Dim splitValue() As String Dim i As Integer Dim l As Variant Dim lFiltered As Variant Dim lastRow As Integer 'Here I found the last row from the table lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row 'I do this because when the filter filters everything, lastRow = 1 so I got an erros on lFiltered range, it becames Range("A2:F1") If lastRow < 2 Then lastRow = 2 End If 'Here I get an array with all the visible rows from the table -> lFiltered(row, column) = value lFiltered = Sheets("SIP").Range("A2:F" & lastRow).SpecialCells(xlCellTypeVisible).Cells 'I have duplicated entries, so I insert everything in a Collection, so it only allows me to have one of each value on error resume next For i = 1 To UBound(lFiltered) currentValue = Trim(lFiltered(i, column)) If currentValue <> 0 Then If currentValue <> "" Then 'Cammel case the string currentValue = UCase(Left(currentValue, 1)) & LCase(Mid(currentValue, 2)) 'Upper case the content in between "( )" splitValue = Split(currentValue, "(", 2) currentValue = splitValue(0) & "(" & UCase(splitValue(1)) 'Insert new item to the collection listaDados.Add Item:=currentValue, Key:=currentValue End If End If Next i i = 1 'Here I copy the collection to an array ReDim Preserve comboList(0) comboList(0) = "" For Each l In listaDados ReDim Preserve comboList(i) comboList(i) = l i = i + 1 Next l 'Here I assign that array to the combobox formPerda.Controls("cGrupo" & column).List = comboList 

— редактировать —

Вот как я управлял кодом, чтобы работать так, как я хочу.

 'Get the last row the filter shows lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row 'To avoid to get the header of the table If lastRow < 2 Then lastRow = 2 End If 'Get the multiple range showed by the autofilter Set lFilteredAux = Sheets("SIP").Range("A2:F" & lastRow).Cells.SpecialCells(xlCellTypeVisible) 'Check if there is more than 1 no contiguous areas If Sheets("SIP").Range(lFilteredAux.Address).Areas.Count > 1 Then 'If Yes, do a loop through the areas For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count 'And add it to the lFiltered array ReDim Preserve lFiltered(i - 1) lFiltered(i - 1) = Sheets("SIP").Range(lFilteredAux.Address).Areas(i) Next i Else 'If there is only one area, it goes the old way ReDim lFiltered(0) lFiltered(0) = Sheets("SIP").Range(lFilteredAux.Address) End If 

Теперь у меня есть lFiltered массив, немного отличающийся от того, как я использовал, но я адаптировал свой foreach для работы следующим образом:

 For i = 0 To UBound(lFiltered) For j = 1 To UBound(lFiltered(i)) currentValue = Trim(lFiltered(i)(j, columnNumber)) next j next i 

Большое спасибо! = D

Очевидная производительность здесь заключается в том, что вы используете ReDim Preserve в узком цикле.

Чтобы объяснить, что небольшое заявление ReDim Preserve выполняет большую работу. Если у вас есть массив размером 4 и вы ReDim его размер 5, он выделяет 5 пробелов, а также копирует по 4 значениям из предыдущего массива. Если вы затем переименуете его в размер 6, он выделяет 6 пробелов, а также копирует по 5 значениям из предыдущего массива.

Скажем, у вас всего 1000 значений. При написании кода вы думали, что вы просто выделили 1000 элементов в массиве и скопировали их. Это будет в линейном времени, операция O (n). По правде говоря, вы выделяли 1 + 2 + 3 + 4 … + 1000 элементов = выделение и копирование 500 000, что было бы в полиномиальное время, операция O (n ^ 2).

Решение:

1) Вне цикла, выясните размер вашего массива, а затем только ReDim Preserve один раз.

То есть, во-первых:

 Dim totalSize as Long, i as Long For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count totalSize += 1 Next I 

И как только у вас есть размер:

 ReDim Preserve lFiltered(totalSize - 1) For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count lFiltered(i - 1) = Sheets("SIP").Range(lFilteredAux.Address).Areas(i) Next i 

2) Вместо использования массива, который требует изменения размера, и для которого требуется определенный размер ReDim Preserve, используйте коллекцию. Внутри коллекция реализована как нечто похожее на связанный список, так что добавление элемента происходит в постоянное время (так что O (1) для каждой операции и, следовательно, O (n) total для вставки всех n элементов).

 Dim c as New Collection ReDim Preserve lFiltered(totalSize - 1) For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count c.Add Sheets("SIP").Range(lFilteredAux.Address).Areas(i) Next i 

Я думаю, вам нужен набор :

 Sub dural() lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row Set lFiltered = Sheets("SIP").Range("A2:F" & lastRow).Cells.SpecialCells(xlCellTypeVisible) MsgBox lFiltered.Address End Sub 
  • EXCEL MACRO - выполнять vlookup только на пустых ячейках
  • Считать количество записей в течение одного года и другие критерии
  • Подвижная таблица VBA: Добавить фильтр
  • Фильтрация столбцов на основе массива с другого листа
  • Как использовать автофильтр VBA с подстановочными знаками на обеих строках и цифрах?
  • выполнять фильтрацию макроса на листе excel в рабочей книге, с другого листа в другой книге
  • Не отвечающее состояние во время поиска в VBA
  • Таблица фильтров VBA и подмножество копирования итоговых столбцов в буфер обмена
  • Значение по умолчанию для фильтра отчета о сводной таблице closedxml
  • Excel VBA фильтрует столбец, а затем копирует каждый элемент в коллекции области в соответствующую строку
  • VBA / Macro, чтобы добавить еще один colum с условиями
  • Interesting Posts

    VBA: двойной фильтр на листе, как отфильтровать данные между двумя определенными интервалами

    Как сохранить гиперссылку на мои результаты поиска?

    Таблицы Google – значения сумм на основе значения Row и заголовка столбца

    VBA: установка объекта в цикле for, объект, вставленный на первое значение

    jXLS jx: изображение заканчивается на java.lang.IllegalArgumentException: значение imgBean должно содержать байты изображения

    Ошибка 1004 – Vlookup в vba – невозможно получить свойство Vlookup класса WorksheetFunction

    Excel: получение данных на основе столбца

    может ли любая формула клеток excel делить свое значение на 1000?

    Символы и пространства VBA Excel, объединяющие несколько строк

    Как узнать имена ячеек при выборе диапазона с помощью VBA

    pandas to_excel () с использованием параметра float_format -> ValueError: невозможно преобразовать строку в float

    Согласование столбцов между листами и перенос имен

    Очистить содержимое ячейки при изменении предыдущей ячейки

    Python 3 – Слияние .xls / удаление строк / удаление дубликатов

    C #: как оценить формулу excel, состоящую из диапазонов имен, используя NPOI или любую другую библиотеку

    Давайте будем гением компьютера.