我正在尝试使用来自已过滤数据库的信息填充列表框,并且一切正常,除了显示内容仅显示已过滤的第一行。我真的不知道该怎么办
我已经尝试过使用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)
您不能像这样将一个范围内的所有可见单元格添加到数组,它会在第一次跳过某个单元格时停止,因为您一次只能向一个数组分配一个范围,并且从技术上讲,您要添加多个范围(因为您跳过了单元格)。
要解决此问题,您可以在过滤范围内运行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.的建议,Edit:我已经切换了数组的分配方式,修改了Redim
语句以进行匹配,然后将其分配给具有.column
属性的列表框。这样可以消除行尾多余的行。