フィルタリングされたデータを複数列リストボックスのrowsourceとして取得する方法は？

Question

私はSheet2のデータを以下のように持っています。
実際のデータ

その後、私は手動でのように見えるこれらのデータにファイラーを適用...
フィルタリングされたデータ

私は（ユーザーフォームを持っていますUserForm1）とリストボックス（ListBox1）をフォームに入力します。コマンドボタンcmdFilteredDataもあります。だから、私はフィルタリングされたデータだけでリストボックスを埋めるしたい。私は以下のコードを作るが、それは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

代替機能へ - 信頼できない - この答えは完全シャイラドーの感謝を溶液に意向SpecialCells（xlCellTypeVisible）

、それを修正していません。

しかし、上記のソリューションをテストすると、SpecialCells(xlCellTypeVisible)および/またはCurrentRegionを参照すると、（OPの小さな範囲内であっても）問題が発生する可能性があります。
可能な回避策（udfsの場合）は、SpecialCells(xlCellTypeVisible) not working in 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 

（ノートの上を参照）シャイラドーのソリューションは、わずかに変更された

いずれの場合も、対象範囲は、あなたがそのようは、コピーして、より良い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 

リンク：

Microsoft - udf not working

ExcelForum - xlCelltypeVisible not working

MrExcel - SpecialCells not working