使用先前过滤的数据填充列表框

Question

我正在尝试用过滤数据中的信息填充列表框。

显示仅显示筛选的第一行。

我试过了specialcells(xlcelltypevisible)。

这是一些代码：

Private Sub UserForm_Initialize()

Dim Rang1 As Range
Dim LastCell As Long
Dim LastCell1 As Long
Dim WS As Worksheet
Dim Rang  As Range
Dim MyArr As Variant

Set WS = ThisWorkbook.Worksheets("Sheet1")

    'Define last row
    With WS
        LastCell = .Range("A" & Sheets("Mt-Gral").Rows.Count).End(xlUp).Row
    End With

    'Define filtering range
    Set Rang = WS.Range("A2:Q" & LastCell)

    'Filter
    WS.Activate

    Rang.Select
    Selection.AutoFilter Field:=10, Criteria1:="<>Closed"
    Selection.AutoFilter Field:=4, Criteria1:="<>Production"
    Set Rang1 = Rang.SpecialCells(xlCellTypeVisible)

    MyArr = Rang1

    With Me.ListBox1
        .ColumnCount = 8
        .ColumnWidths = "80pt;80pt;40pt;60pt;60pt;60pt;60pt;150pt"
        .MultiSelect = fmMultiSelectExtended
        .List = (MyArr)

Answer 1

您不能像这样将范围内的所有可见单元格添加到数组中，它会在第一次跳过单元格时停止，因为您一次只能将一个范围分配给数组，从技术上讲，您是添加多个范围（因为您跳过了单元格）。

要解决此问题，您可以在过滤范围内运行一个 for each，然后将所有可见单元格分别添加到数组中。像这样：

Sub listbox()
Dim i       As Long, lastr As Long, j As Long
Dim cel     As Range
Dim Myarr() As Variant
Dim rang    As Range

lastr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Set rang = Sheet1.Range("A2:A" & lastr)

ReDim Myarr(0 To 17, 0 To lastr)
For Each cel In rang

    If Not cel.Rows.Hidden Then
        For j = 0 To 17
            Myarr(j, i) = cel.Offset(0, j)
        Next j
        i = i + 1
    End If

Next cel
ReDim Preserve Myarr(0 To 17, 0 To i - 1)

With Sheet1.ListBox1
    .Column = Myarr
End With

End Sub

编辑： 根据 T.M 的建议我已经切换了数组的分配方式，调整了 Redim 语句以匹配，并且使用 .column 属性将其分配给列表框。这会消除最后多余的行。

使用先前过滤的数据填充列表框

Populating a listbox with previously filtered data

excel

vba

listbox

autofilter