用于填充 ListBox 的过滤数据数组

Question

好的，我正在按以下条件筛选 sheet ("Data")：

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

然后，我想将过滤后的 Table 填充到列表框我的问题是，行数可能会有所不同，所以我想我可以通过执行此 cells.find 例程来尝试列出过滤的 table "ends" 的位置：

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

不幸的是，这也计算了 "hidden" 行，所以在我的例子中它不是 2 而是 7.. 我以前用过.Range.SpecialCells(xlCellTypeVisible)，但它似乎对上面的cells.find不起作用。有人知道如何计算可见（=过滤）Table，然后将其放入列表框吗？

编辑：我像这样填充列表框（未过滤）：

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 就会创建一个 hidden named range。如果您有连续数据 (headers/rows)，这将 return 您的范围而无需查找。尽管它看起来像 UsedRange，但搜索您最后使用的列和行并创建您自己的 Range 变量进行过滤可能仍然更好。对于这个练习，我将保留它。此外，如上面的评论所示，可以遍历 Areas 个可见单元格。我建议事先检查一下，以确保除了 headers.

之外还有过滤数据

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

如果没有 headers 明显缺失，以上方法有效。

Answer 2

如果你想使用一个连续的（内置的）数组，请尝试下一个代码。也可以从不连续的范围地址构建它：

    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

Answer 3

这里是一个 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

为了找到 x（行数）我们不需要第一个循环...简单地说，x = filtRng.Cells.Count / filtRng.Columns.Count 就足够了

用于填充 ListBox 的过滤数据数组

Array of filtered data to populate ListBox

excel

vba

listbox