필터링 된 목록 만 목록 상자에 1 행 표시

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

이 보이는 옳은. 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

다른 시트의 다른 영역에 복사 가장 것 같다

여기에 제공되는 샘플입니다. 같은

뭔가 :

Sub listit() 
    Dim Rng As Range, Cl As Range, RaTo As Range, Ri&, Rl& 

    Rl = Range("E65536").End(xlUp).Row ' end of column "E" 

    If Rl > 11 Then ' only taking from row 11 down to row RL 
     Set Rng = ActiveSheet.Range("e11:e" & Rl).SpecialCells(xlCellTypeVisible) 
     ' 
     ' Range to on another sheet FilteredWork .. as work space only 

     Set RaTo = Sheets("FilteredWork").Range("B10").CurrentRegion 
     RaTo.ClearContents 

     'Rng.Copy RaTo(1, 1) if one column 

     UFJ.ListBox1.ColumnCount = 2 

     ' pick what columns of the filtered data you need for what columns of the list 
     For Each Cl In Rng 
      Ri = Ri + 1 
      RaTo(Ri, 1) = Cl(1, 1).Value ' col "E" 
      RaTo(Ri, 2) = Cl(1, -2).Value ' col "B" 
     Next Cl 
    End If 

    Set RaTo = Sheets("FilteredWork").Range("B10").CurrentRegion ' find the new data 
    UFJ.ListBox1.RowSource = "FilteredWork!" & RaTo.Address 

End Sub