从复制的范围创建组合框

Question

我选择了要在组合框中显示的范围。 代码如下。

Sheet5.Activate
ActiveSheet.ListObjects("Table6").Range.AutoFilter Field:=1, Criteria1:= _
    "=*E*", Operator:=xlAnd
Range("A1").Select
ActiveCell.Offset(1, 2).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

在不改变上面代码的情况下，有没有办法改变下面的代码来选择Selection.Copy？

或者有没有办法将Range(Selection, Selection.End(xlDown)) 部分更改为Selection.Copy 以上？

With cbE
    Me.cbE.List = Worksheets("EMP").Range(Selection, Selection.End(xlDown)).Value
End With

---

如何从表格中过滤掉行（基于包含特定文本的第 1 列）并在组合框中显示过滤列（第 4 过滤列）？

---

更新

    With Sheet4
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        Dim filterRange As Range
        Set filterRange = .Range("A2:A" & lastRow)
        
        With filterRange
            .AutoFilter 1, "E"
            Dim filterE As Range
            Set filterE = .Range("A1:A" & lastRow).Columns(5).SpecialCells(xlCellTypeVisible)
        End With
    End With
    Me.cbE.List = Worksheets("EMP&Customers").Range(filterE, filterE.End(xlDown)).Value

上面是我拥有的最新代码，它工作正常，除了第一个和最后一个过滤单元格之间的任何单元格也将在组合框中可见。

Issue_elaboration

Answer 1

将您选择的范围设置为您以后可以使用的变量，即使选择发生更改，也可以引用该范围。

With Sheet5
    .ListObjects("Table6").Range.AutoFilter Field:=1, Criteria1:="=*E*", Operator:=xlAnd

    Dim CopiedRange As Range 'set your range to a variable
    Set CopiedRange = .Range(.Cells(2, 3), .Cells(2, 3).End(xlDown))

    CopiedRange.Copy 'you can remove this line unless you want to paste the copied range somewhere.
End With

'Use this variable to refer to the range
Me.cbE.List = Worksheets("EMP").Range(CopiedRange, CopiedRange.End(xlDown)).Value

Answer 2

请尝试下一个方法：

复制表单代码模块中的下一个代码（如果其Initialize事件已被使用，请同时添加以下事件代码）：

Private Sub UserForm_Initialize()
  Dim sh As Worksheet, rngVis As Range, arrVis, cbE As MSForms.ComboBox
  
  Set sh = Sheet5 'ActiveSheet - I used it to make some tests...
  With sh
     .ListObjects("Table6").Range.AutoFilter field:=1, Criteria1:="=*E*", Operator:=xlAnd
     Set rngVis = .Range(.cells(2, 3), .cells(2, 3).End(xlDown)).SpecialCells(xlCellTypeVisible)
  End With
  arrVis = makeContRng(rngVis)
  Me.cbE.list = WorksheetFunction.Transpose(arrVis)
End Sub

Private Function makeContRng(rng As Range) As Variant 'continuous with one column
    Dim arr, ar As Range, iRow As Range, i As Long, j As Long, k As Long
    
    ReDim arr(1 To rng.cells.count, 1 To 1)
    For Each ar In rng.Areas
        k = k + 1
         arr(k, 1) = ar.Value
    Next ar
    makeContRng = arr
End Function