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)有谁知道如何计算可见的（=过滤的）表，然后把它放在Listbox中？

EDIT: 我像这样填充列表框（未过滤）。

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

下面是一个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 2

这里有一个有趣的小事实。Excel 创建一个 隐名系列 一旦你开始过滤数据。如果你有连续的数据（headersrows），这将返回你的范围，而无需寻找它。虽然因为它看起来像 UsedRange 最好还是搜索你最后使用的列和行，然后创建你自己的 Range 变量来过滤。在这个练习中，我就不说了。此外，正如上面的评论中所指出的，我们可以循环使用 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 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