VBA - массив отфильтрованных данных для заполнения списка

Question

Хорошо, я фильтрую лист («Данные») по критерию:

Sub Filter_Offene()
    Sheets("Data").Range("A:R").AutoFilter Field:=18, Criteria1:="WAHR"
End Sub

Затем я хочу поместить отфильтрованную таблицу для заполнения списка. Моя проблема заключается в том, что количество строки могут различаться, поэтому я подумал, что могу попробовать и перечислить, где «заканчивается» отфильтрованная таблица, выполнив эту процедуру Cell.find:

Dim lRow As Long
Dim lCol As Long

    lRow = ThisWorkbook.Sheets("Data").Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

lRow = lRow + 1

Это не всегда подсчитывает «скрытые» строки, поэтому в моем примере это не учитывает 2, а 7. Раньше я использовал .Range.SpecialCells(xlCellTypeVisible), но, похоже, он не работает с Cell.find выше. Есть ли у кого-нибудь идея, как я могу подсчитать видимую (= отфильтрованную) таблицу, а затем поместить ее в список?

РЕДАКТИРОВАТЬ: Я заполняю список (нефильтрованный) следующим образом:

Dim lastrow As Long
With Sheets("Data")
    lastrow = .Cells(.Rows.Count, "R").End(xlUp).Row
End With

With Offene_PZ_Form.Offene_PZ
.ColumnCount = 18
.ColumnWidths = "0;80;0;100;100;0;50;50;80;50;0;0;0;0;0;150;150;0"
.List = Sheets("Data").Range("A2:R" & lastrow).Value
End With

Но это не будет работать с отфильтрованными данными.

Answer 1

Вот небольшой забавный факт: Excel создает скрытый именованный диапазон , как только вы начинаете фильтровать данные. Если у вас есть непрерывные данные (заголовки / строки), это вернет ваш диапазон, не ища его. Хотя, поскольку он кажется похожим на UsedRange, все же может быть лучше выполнить поиск в вашем последнем использованном столбце и строке и создать свою собственную переменную Range для фильтрации. Для этого упражнения я оставлю это в покое. Кроме того, как указано в комментариях выше, можно увеличить oop над Areas видимых ячеек. Я бы порекомендовал проверить заранее, чтобы быть уверенным, что есть отфильтрованные данные, кроме заголовков.

Sub Test()

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Data")
Dim Area as Range

ws.Cells(1, 1).AutoFilter 18, "WAHR"    
With ws.Range("_FilterDatabase")
    If .SpecialCells(12).Count > .Columns.Count Then
        For Each Area In .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(12).Areas
            Debug.Print Area.Address 'Do something
        Next
    End If
End With

End Sub

Вышеупомянутое работает, если заголовки явно отсутствуют.

Answer 2

Вот код VBA для заполнения UserForm1.ListBox1.List отфильтрованными строками. Спасибо @FaneDuru за улучшения в коде, отредактированном в соответствии с его комментариями.

В коде Userform1

Private Sub UserForm_Initialize()
PopulateListBoxWithVisibleCells
End Sub

В модуле

Sub PopulateListBoxWithVisibleCells ()

Dim wb As Workbook, ws As Worksheet
Dim filtRng As Range, rw As Range
Dim i As Long, j As Long, x As Long, y As Long, k As Long, filtRngArr
i = 0: j = 0: x = 0: y = 0

Set wb = ThisWorkbook: Set ws = wb.Sheets("Sheet1")

Set filtRng = ws.UsedRange.Cells.SpecialCells(xlCellTypeVisible)

For Each Area In filtRng.Areas
x = x + Area.Rows.Count
Next
y = filtRng.Columns.Count
ReDim filtRngArr(1 To x, 1 To y)

For k = 1 To filtRng.Areas.Count
For Each rw In filtRng.Areas(k).Rows
    i = i + 1
    arr = rw.Value
    For j = 1 To y
    filtRngArr(i, j) = Split(Join(Application.Index(arr, 1, 0), "|"), "|")(j - 1)

    Next
Next
Next

With UserForm1.ListBox1
.ColumnCount = y
.List = filtRngArr
End With

End Sub

Мы также можем добавить больше полей с указанием номера строки, например Split(rw.Row & "|" & Join(Application.Index(arr, 1, 0), "|"), "|")(j - 1), но для каждого такого предполагаемого приращения столбца нам нужно увеличить значение y, например y = filtRng.Columns.Count + 1

Answer 3

Попробуйте, пожалуйста, следующий код, если вы хотите использовать непрерывный (построенный) массив. Его также можно построить из адреса прерывного диапазона:

    Sub Filter_Offene()
      Dim sh As Worksheet, lastRow As Long, rngFilt As Range, arrFin As Variant

      Set sh = Sheets("Data")
      lastRow = sh.Range("R" & Rows.count).End(xlUp).Row
        rngFilt.AutoFilter field:=18, Criteria1:="WAHR"

        Set rngFilt = rngFilt.Offset(1).SpecialCells(xlCellTypeVisible)

        arrFin = ContinuousArray(rngFilt, sh, "R:R")

        With ComboBox1
            .list = arrFin
            .ListIndex = 0
        End With
    End Sub

    Private Function ContinuousArray(rngFilt As Range, sh As Worksheet, colLet As String) As Variant
        Dim arrFilt As Variant, El As Variant, arFin As Variant
        Dim rowsNo As Long, k As Long, i As Long, j As Long, arrInt As Variant

        arrFilt = Split(rngFilt.address, ",")' Obtain an array of areas addresses
        'real number of rows of the visible cells range:
        For Each El In arrFilt
             rowsNo = rowsNo + Range(El).Rows.count
        Next
        'redim the final array at the number of rows
        ReDim arFin(1 To rowsNo, 1 To rngFilt.Columns.count)

        rowsNo = 1
        For Each El In arrFilt            'Iterate between the areas addresses
            rowsNo = Range(El).Rows.count 'number of rows of the area
            arrInt = ActiveSheet.Range(El).value' put the area range in an array
            For i = 1 To UBound(arrInt, 1) 'fill the final array
                k = k + 1
                For j = 1 To rngFilt.Columns.count
                     arFin(k, j) = arrInt(i, j)
                Next j
            Next i
        Next
    ContinuousArray = arFin
End Function