筛选数据的数组以填充ListBox

Question

筛选数据的数组以填充ListBox

5

好的，所以我正在按照特定条件过滤一张名为“Data”的表格：

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)，但似乎无法与上面的cells.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

但是这在筛选后的数据中将无法工作。

- Leon S

已经在这里回答了..过滤数据的行数..只需确保您在函数中引用的列中有过滤数据。如果您的数据从B列开始，请引用B列。 - Naresh

1

筛选范围的 SpecialCells(xlCellTypeVisible) 范围在大多数情况下是不连续的。因此，为了获得所需内容，还需要说明如何加载它。是全部筛选范围，还是仅一列中的值？您想将其链接到一个范围，还是分别加载项目？然后，必须将区域范围限制为最后一个单元格，而不是所有列... - FaneDuru

@FaneDuru 我想在用户窗体列表框中显示筛选后的行。但是我的大脑似乎无法理解；我可以放入未经过滤的数据，并且我正在像您在我的问题编辑中看到的那样进行操作。 - Leon S

1

@NareshBhople 谢谢。我看了一下，但我不知道我是否需要那个。我只需要一个简单的解决方案来填充列表框，使其显示工作表上可见的数据（即筛选后的数据）。 - Leon S

你的代码在连续范围内运行，创建了一个连续的二维数组，当你将它加载到“列表”的列表框中时，可以按行和列进行拆分。在这种情况下（筛选、不连续范围），我认为需要在筛选范围的区域之间进行迭代，并为特定可见单元格行/片段构建数组。或者，当迭代到筛选范围的某一行时，逐列加载每个列表框列。 - FaneDuru

我也发布了一段代码，可以从可见单元格范围中创建一个连续的数组。这样的数组可以一次性放入您的列表框中。请测试并确认它是否按照您的需求正常工作。 - FaneDuru

3个回答

2

这是一个用于填充筛选行到 UserForm1.ListBox1.List 的 VBA 代码。感谢 @FaneDuru 根据他的评论对代码进行了改进。

在 Userform1 代码中。

Private Sub UserForm_Initialize()
PopulateListBoxWithVisibleCells
End Sub

在模块中

子填充可见单元格列表框()

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 就足够了。

- Naresh

1

注释中的信息不能被视为答案。因此，欢迎提供额外的回答来说明这一点。 - JvdV

1

这段代码只在“特殊”情况下才能工作。我的意思是，只有在每个区域都只有一行的情况下，而且很少出现过滤的情况下才能工作。因此，x不能是区域的计数，除非是上述情况。然后，该代码还包括列标题，这在加载组合框时不是正常做法... - FaneDuru

1

@FaneDuru。我尝试添加一个循环来首先从区域计算行数。这给了我x来重新定义filtRngArr数组。然后在原始循环中，我添加了一个用于areas.count的循环。这很有帮助。感谢您的输入。 - Naresh

1

不错的想法（至少看起来不错...），使用数组切片是个好主意，但请使用 i 代替数字1 进行修改。否则，在有多行的情况下，代码将会重复第一行区域... 不管怎样，我会点赞的（特别是对于这种方法）。它的耗时与迭代时间相似（实际上略微更长），但它看起来很好... :) - FaneDuru

1

你是对的，抱歉...我看着你的代码时，有点像我的那个反射，当迭代数组行时。我在我的代码上测试了你的想法，那里确实需要这种适应性。我没有仔细看你的代码。 - FaneDuru

显示剩余6条评论

1

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

    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

- FaneDuru

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- JvdV · Accepted Answer

一个有趣的小事实是，Excel在开始筛选数据时会创建一个隐藏的命名区域。如果您具有连续的数据（标题/行），它将返回您的范围而无需查找它。尽管它似乎类似于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

上述方法仅在没有缺失头信息的情况下有效。