Question

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

我的脚本过滤数据并将结果返回到列表框中。

一切似乎都运行正常，但是当我过滤两个字段时，它只返回一个结果，而不是数据列表。我已经完成了代码，它正在过滤，只是没有显示结果。

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

工作代码是：

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'中的完整列表，但下面的代码只返回第一个结果：

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

Answer 1

看起来David是正确的。请参阅SO上的this answer。

以下是摘要：

您不能使用非连续范围的单元格，因此您需要先将这些单元格的值分配给数组，然后将该数组分配给列表框的.List。

以下是提供的示例：

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

Answer 2

另一张纸上另一个范围的副本似乎最好。

类似的东西：

1) What does this error mean?
2) How can I find the ssl version used on the client side and server side?
3) Little explanation will help.

过滤列表仅在列表框中显示1行

2 个答案: