如何获得过滤数据作为多列列表框的行源？

我有Sheet2数据，如下所示。
实际数据

然后，我手动应用Filer的数据，看起来像…
过滤的数据

我有一个窗体中的用户窗体（UserForm1）和一个列表框（ ListBox1 ）。 还有一个命令buttoncmdFilteredData 。 所以，我想只填充过滤数据的列表框。 我下面的代码，但它给Type mismatch错误。

 Private Sub cmdFilteredData_Click() Dim FilteredRange As Range Set FilteredRange = Sheet2.Range("A1:C5").Rows.SpecialCells(xlCellTypeVisible) With Me.ListBox1 .ColumnCount = 3 .MultiSelect = fmMultiSelectExtended .RowSource = FilteredRange End With End Sub 

任何帮助是衷心的感激。

Answer 1

由于您正在尝试使用已筛选范围的值填充ListBox1 ，所以在中间有空白行，这会“混淆” ListBox 。

相反，您可以复制>>将值粘贴到右侧（或另一个工作表）上的列，使用数组来填充这些值，然后用数组填充ListBox1 。

码

 Private Sub cmdFilteredData_Click() Dim FilteredRange As Range Dim myArr As Variant Set FilteredRange = ThisWorkbook.Sheets("Sheet8").Range("A1:C5").SpecialCells(xlCellTypeVisible) ' copy filtered range to the columns on the right (if you want, you can add a "Dummy" sheet), to have the range continous FilteredRange.Copy Range("Z1") ' populae the array with new range values (without blank rows in the middle) myArr = Range("Z1").CurrentRegion With Me.ListBox1 .ColumnCount = 3 .MultiSelect = fmMultiSelectExtended .List = (myArr) End With End Sub 

Answer 2

替代function – 不可靠 – SpecialCells（xlCellTypeVisible）

这个答案意图完成 Shai Rado的赞赏的解决scheme，而不是纠正它。

然而，testing上述解决scheme显示，使用SpecialCells(xlCellTypeVisible)和/或对CurrentRegion引用可能会导致问题（即使在OP的小范围内）。
SpecialCells（xlCellTypeVisible）中提供了一个可能的解决方法（尤其是udfs）， 在UDF中不起作用 。

 Private Function VisibleCells(rng As Range) As Range ' Site: https://stackoverflow.com/questions/43234354/specialcellsxlcelltypevisible-not-working-in-udf ' Note: as proposed by CalumDA Dim r As Range For Each r In rng If r.EntireRow.Hidden = False Then If VisibleCells Is Nothing Then Set VisibleCells = r Else Set VisibleCells = Union(VisibleCells, r) End If End If Next r End Function 

Shai Rado的解决scheme稍作修改（参见上面的注释）

在任何情况下，目标范围必须在复制之前清除 ，然后在没有 CurrentRegion 情况下更好地引用，以便仅获取所需的项目。 这些变化对我有用。

 Option Explicit Private Sub cmdFilteredData_Click() Dim ws As Worksheet Dim sRng As String Dim FilteredRange As Range Dim myArr As Variant Dim n As Long Set ws = ThisWorkbook.Worksheets("Filtered") n = ws.Range("A" & ws.Rows.Count).End(xlUp).Row ' get last row sRng = "A1:C" & n ' Set FilteredRange = ws.Range(sRng).SpecialCells(xlCellTypeVisible) ' << not reliable Set FilteredRange = VisibleCells(ws.Range(sRng)) ' <<<< possible ALTERNATIVE ' clear target range in order to allow correct array fillings later ! ws.Range("Z:AAB").Value = "" ' copy filtered range to the columns on the right FilteredRange.Copy ws.Range("Z1") ' populate the array with new range values (without blank rows in the middle) ' myArr = ws.Range("Z1").CurrentRegion ' sometimes unreliable, too myArr = ws.Range("Z1:AAB" & ws.Range("Z" & ws.Rows.Count).End(xlUp).Row) ' <<< better than CurrentRegion With Me.ListBox1 .ColumnCount = 3 .MultiSelect = fmMultiSelectExtended .List = (myArr) End With End Sub 

引用文章中提到的链接：

微软 – udf不工作

ExcelForum – xlCelltypeVisible不能正常工作

MrExcel – SpecialCells不工作