使用VBA和Like运算符过滤由命名范围填充的ActiveX下拉列表

时间:2019-04-17 14:16:56

标签: excel vba

我需要过滤ActiveX组合框中的列表以根据部分条件进行匹配,并且不允许不在列表中的条目。我正在使用64位Excel 2013 VBA。组合框由命名范围填充,下拉列表的目标单元格是一个包含在单元格下拉列表中设置为的数据验证的单元格。

我尝试使用控件的change子例程,但是列表当前由命名范围驱动,因此传递的变量返回类似 $ B $ 34:$ B $ 60。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2018/9/21

'Variable declarations
    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr

ActiveSheet.Protect

'Set reference to the current worksheet
    Set xWs = Application.ActiveSheet


'Handle any error by continuing through code without halt
    On Error Resume Next

'Set an instance of the object for manipulation
    Set xCombox = xWs.OLEObjects("TempCombo")

 'Initial settings for combo box
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With

'Check to see if selected cell in the worksheet is set to dropdown due to
'data validation settings and shutdown the dropdown if true
'Check the contents of the selection and exit if blank
    If Target.Validation.Type = 3 Then
            Target.Validation.InCellDropdown = False
            Cancel = True
            xStr = Target.Validation.Formula1
            xStr = Right(xStr, Len(xStr) - 1)
            If xStr = "" Then
                Set xCombox = Nothing
                Exit Sub
            End If
            With xCombox
                'Temporarily turn off protection to prevent
                'multiple combo boxes from appearing in sheet
                    ActiveSheet.Unprotect
                'Set appearance of combo box and display it
                    .Visible = True
                    .Left = Target.Left
                    .Top = Target.Top
                    .Width = Target.Width ' + 5
                    .Height = Target.Height + 5
                    .ListFillRange = xStr
                If .ListFillRange = "" Then
                    xArr = Split(xStr, ",")
                    Me.TempCombo.List = xArr

                End If
                'Set a link to the active cell in the
                'worksheet so combo box data fills it
                    .LinkedCell = Target.Address
            End With
            'Activate the combo and display
            'the list
                xCombox.Activate
                Me.TempCombo.DropDown
            'turn worksheet protection back on
            'since it was turned off above
                ActiveSheet.Protect
    End If

'Release the object to prevent memory issues
    Set xCombox = Nothing

End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
        Case 9
            Application.ActiveCell.Offset(0, 1).Activate
        Case 13
            Application.ActiveCell.Offset(1, 0).Activate
    End Select
End Sub

组合框的当前行为:用户必须输入所需匹配项的前几个字母,列表会跳至适当的位置。

示例: 用户类型San 下拉菜单跳升了旧金山(SFO)

组合框的预期行为:**用户可以输入**任何部分匹配的字符串

示例: 用户类型San 下拉列表跳至旧金山(SFO)

用户类型Fra 下拉列表跳至旧金山(SFO)

用户类型SFO 下拉列表跳至旧金山(SFO)

0 个答案:

没有答案