Excel VBA-用于填充列表框的筛选数据数组

好的，我根据以下条件过滤一张表（“数据”）：

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

然后，我想将过滤后的表放入一个列表框中 我这里的问题是，行的数量可能会有所不同，所以我想我可以尝试通过这样做列出筛选表“结束”的位置。查找例程：

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）

，但它似乎不能与上面的单元格一起工作。 有人知道我如何计算可见（=过滤）表，然后将其放入列表框中吗

编辑：我按如下方式填充列表框（未过滤）：

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

---

但这对过滤后的数据不起作用。

这里有一个有趣的小事实，

Excel

一旦开始过滤数据，就会创建一个。如果您有连续的数据（标题/行），这将返回您的范围而不查找它。虽然它看起来很像

UsedRange

，但最好还是搜索上次使用的列和行，并创建自己的

范围

变量进行筛选。对于这个练习，我不做了。此外，如上面的注释所示，可以在可见单元格的

区域上循环。我建议事先进行检查，以确保安全，是否存在除标题以外的已过滤数据

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

如果没有明显的头丢失，上述方法可以工作。
如果要使用连续（构建）数组，请尝试下一个代码。也可以从不连续的范围地址构建它：

    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

下面是一个VBA代码，用于用筛选的行填充
UserForm1.ListBox1.List
。
感谢@FaneDuru根据其评论编辑的代码的改进

在Userform1代码中

Private Sub UserForm_Initialize()
PopulateListBoxWithVisibleCells
End Sub

模块内

子PopulateListBoxWithVisibleCells（）


我们还可以添加更多的字段，如
Split（rw.row&“|”&Join（Application.Index（arr，1，0），“|”），“|”等行数（j-1）
，但对于每一个这样的预期列增量，我们需要增加y值，如
y=filterng.Columns.Count+1
，这里已经给出了答案。。只需确保在函数中引用的列中过滤了数据。如果数据从B列开始，请参阅B列。在大多数情况下，过滤范围的
特殊单元格（xlCellTypeVisible）
范围是不连续的。因此，为了获得您需要的内容，还需要说明您希望如何加载它。所有过滤范围，还是仅一列中的值？要将其链接到某个范围，还是单独加载项目？然后，您必须将区域范围限制到最后一个cel，而不是所有列…@FaneDuru我想在我的userform列表框中显示过滤后的行。但我的大脑似乎没有达到目的；我可以输入未过滤的数据，就像你在我的Question@NareshBhople谢谢我看过了，但我不知道我是否需要它。我只需要一个简单的解决方案，用工作表上可见的数据填充列表框（因此过滤后），您的代码在连续范围内工作，这将创建一个连续的二维数组，当您将其加载到列表框的
列表中时，该数组可以按行和列进行拆分。在这种情况下（过滤的、不连续的范围），我认为有必要在过滤范围区域之间进行迭代，并为特定的可见单元格行/切片构建一个数组。或者，当迭代到达筛选范围的一行时，逐个加载每个列表框列…变量区域的It错误：未定义变量？啊，顶部有
Option Explicit
。很好。我很懒，但是你应该为
Area
then=）设置一个范围变量。调整好了，天哪。只是粘贴了它，检查了调试和该死的工作！非常感谢。我发誓我是如此压抑，因为它。。。可以所以现在我有了所有的行！呃，还有一件事。。我从未使用过阵列（不是2D阵列）。。我认为最好的方法是创建一个包含范围值的数组，然后将它们粘贴到列表框中？或者您可以使用eacht for loop=@LeonS直接向列表框添加一个条目，我想您可以将
Dim arr（）作为变量添加到
列之后。Count
检查
ReDim arr（0到.SpecialCells（12）.Rows.Count，1到.Columns.Count）
。然后，在循环这些
区域时，只需保留一个计数器并填充数组即可。完成后，您可以一次性将数组放入
列表框中。注释中的信息不能被视为答案。因此，尽管如此，提及这一点的其他答案还是值得欢迎的+此代码仅在“特殊”情况下有效。我的意思是，只有在每个区域都有一行的情况下，过滤很少发生。因此，
x
不能是区域
Count
，除非在上述情况下。然后，代码还包括列标题，这在加载组合…@FaneDuru时是不正常的。我尝试添加一个循环，从区域开始首先计算行数。这给了我x来重拨Filterngar阵列。然后在原来的循环中，我又为areas.count添加了一个循环。这有帮助。感谢您的输入。使用数组切片的想法不错（至少看起来不错），但是，请使用
i
而不是1来修改它。否则，如果有更多行，它将重复该区域的第一行。。。无论如何，我会投票支持它（特别是对于这种方法）。它需要类似于迭代的时间（事实上要多一点），但它看起来很不错……）你是对的，对不起。。。当在数组行之间迭代时，我看到您的代码具有我的反射。我在我的代码上测试了你的想法，它需要修改。我没有仔细查看您的代码。
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