已筛选的列表仅在列表框中显示1行 [英] Filtered list only diplaying 1 line in listbox

问题描述

我有一个表单，它是使用单独的电子表格填充数据，该电子表格使用网络查询连接到共享点网站。

I have a form that is populating data from a separate spreadsheet which connects to a sharepoint site using a web query.

我的脚本过滤数据并返回结果一个列表框。

My script filters the data and returns the results into a listbox.

一切似乎都可以正常工作，但是当我过滤两个字段时，它只会返回一个结果，而不是数据列表。我已经通过代码，正确地过滤，只是不显示结果。

Everything seems to work fine, but when I filter two fields it will only return a single result and not the list of data. I have stepped through the code and it is filtering correctly, just not displaying the results.

最令人困惑的是我有完全相同的代码，只有一个过滤器表单的不同页面正确返回数据。

The most confusing thing is I have the exact same code with only one filter on a different page of the form that returns the data correctly.

工作代码是：

Private Sub UpdateActiveButton_Click()

Dim rngVis As Range

Dim Lob As String
Lob = LOBComboBox.Value

Application.ScreenUpdating = False

With Workbooks.Open("Data ssheet")
    With Sheets("Data")

    ActiveSheet.Unprotect
Range("Table_owssvr").ListObject.QueryTable.Refresh BackgroundQuery:=False

        .AutoFilterMode = False

If Lob = "ALL CS" Then

With Intersect(.UsedRange, .Range("A:CM"))
            .Sort Intersect(.Cells, .Parent.Columns("J")), xlAscending, Intersect    (.Cells, .Parent.Columns("A")), , xlAscending, Header:=xlGuess
            .AutoFilter Field:=10, Criteria1:=Array( _
    "CS", "CS2", "CS3"), Operator:=xlFilterValues
            On Error Resume Next
            Set rngVis = .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rngVis Is Nothing Then Me.ActiveListBox.List = rngVis.Value

            ActiveListBox.ColumnWidths = "33;40;0;0;0;80;50;60;0;130"
        End With


Else


If Lob = "ALL MH&S" Then

With Intersect(.UsedRange, .Range("A:CM"))
            .Sort Intersect(.Cells, .Parent.Columns("J")), xlAscending, Intersect    (.Cells, .Parent.Columns("A")), , xlAscending, Header:=xlGuess
            .AutoFilter Field:=10, Criteria1:=Array( _
    "MHS", "MHS2"), Operator:=xlFilterValues
            On Error Resume Next
            Set rngVis = .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rngVis Is Nothing Then Me.ActiveListBox.List = rngVis.Value

            ActiveListBox.ColumnWidths = "33;40;0;0;0;80;50;60;0;130"
        End With

       End If        

End With
    .Close False
End With

Application.ScreenUpdating = True

End Sub

这将返回列表框中的完整列表ActiveListBox ，但下面的代码只会返回第一个结果：

This returns the full list in my listbox 'ActiveListBox', however the below code will only return the first result:

Private Sub CommandButton10_Click()

Dim rngVis2 As Range

Dim Lob2 As String
Lob2 = LOB2ComboBox.Value

Application.ScreenUpdating = False

With Workbooks.Open("data ssheet")
    With Sheets("Data")

    ActiveSheet.Unprotect
Range("Table_owssvr").ListObject.QueryTable.Refresh BackgroundQuery:=False

        .AutoFilterMode = False

If Lob2 = "ALL CS" Then

With Intersect(.UsedRange, .Range("Table_owssvr"))
            .Sort Intersect(.Cells, .Parent.Columns("J")), xlAscending, Intersect(.Cells, .Parent.Columns("A")), , xlAscending, Header:=xlGuess
            .AutoFilter Field:=10, Criteria1:=Array( _
            "CS", "CS2", "CS3"), Operator:=xlFilterValues
            .AutoFilter Field:=2, Criteria1:="Stage 4", Operator:=xlFilterValues
            On Error Resume Next
            Set rngVis2 = .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0

            If Not rngVis2 Is Nothing Then Me.ActiveListBox2.List = rngVis2.Value

            ActiveListBox2.ColumnWidths = "33;40;0;0;0;80;50;60;0;130"

End With

Else


If Lob2 = "ALL MH&S" Then

With Intersect(.UsedRange, .Range("A:CM"))
            .Sort Intersect(.Cells, .Parent.Columns("J")), xlAscending, Intersect(.Cells, .Parent.Columns("A")), , xlAscending, Header:=xlGuess
            .AutoFilter Field:=10, Criteria1:=Array( _
    "MHS", "MHS2"), Operator:=xlFilterValues
           .AutoFilter Field:=2, Criteria1:="Stage 4", Operator:=xlFilterValues
            On Error Resume Next
            Set rngVis2 = .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rngVis2 Is Nothing Then Me.ActiveListBox2.List = rngVis2.Value

            ActiveListBox2.ColumnWidths = "33;40;0;0;0;80;50;60;0;130"
        End With

        End If            

End With
    .Close False
End With

Application.ScreenUpdating = True

End Sub

推荐答案

像大卫是正确的。请参阅SO上的此答案。

Looks like David is correct. See this answer on SO.

以下是摘要：

您不能使用不相邻的单元格范围，因此您需要将这些单元格的值分配给一个数组，然后将数组分配给列表框的 .List 。

You cannot use a non-contiguous range of cells, so you need to assign the values of those cells to an array first, and then assign the array to the listbox's .List.

这里是提供的示例： p>

Here's the sample provided:

Option Explicit

Private Sub CommandButton1_Click()
    Dim Ar() As String
    Dim rng As Range, cl As Range
    Dim i As Long

    Set rng = Range("A1,C1,E1")

    i = 1

    For Each cl In rng
        ReDim Preserve Ar(1, 1 To i)
        Ar(1, i) = cl.Value
        i = i + 1
    Next

    With ListBox1
        .ColumnCount = i - 1
        .ColumnWidths = "50;50;50"
        .List = Ar
    End With
End Sub

这篇关于已筛选的列表仅在列表框中显示1行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！