dropdown list with autocomplete/ suggestion in excel vba

问题

In a merged cell (named as SelName) I have a dropdown list with more then 100 items. Searching through the list is not efficient, as this list is constantly growing. Therefore, I would like to have a dropdown list with autocomplete/ suggestion function. One of the codes that I have is the following which I have found on extendoffice.com:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2017/8/15
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Dim Cancel As Boolean
Set xWs = Application.ActiveSheet

'On Error Resume Next
Set xCombox = xWs.OLEObjects("TempCombo")
With xCombox
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
End With
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 Exit Sub
    With xCombox
        .Visible = True
        .Left = Target.Left
        .Top = Target.Top
        .Width = Target.Width + 5
        .Height = Target.Height + 5
        .ListFillRange = xStr
        .LinkedCell = Target.Address
    End With
    xCombox.Activate
    Me.TempCombo.DropDown
End If
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

First, I tried to test it in an empty sheet (with just the dropdown list) and it worked well. But as soon as I try to insert this code into the other worksheet, it doesn't. Does anyone has an idea what the problem could be? FYI: I have several drop down lists in this worksheet and all of them are in merged cells. Additionally, I have some other Private subs...

回答1:

Why do you have to do that instead of just creating a ComboBox control and setting ListFillRange and LinkedCell without any code?

The error happens because the Range you are editing (Target) does not have any Validation. You should add the check for validation:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim vType As XlDVType
    On Error GoTo EndLine
    vType = Target.Validation.Type

    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim Cancel As Boolean
    Set xWs = Application.ActiveSheet

    'On Error Resume Next
    Set xCombox = xWs.OLEObjects("TempCombo")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    If vType = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.TempCombo.DropDown
    End If
EndLine:
End Sub

EDIT

If i understand the problem correctly, you want a ComboBox that auto-fills from a column and auto-updates if you type more entries in the column. There is no need for such complicated code. You can simply add a ComboBox (say ComboBox1), set its ListFillRange (e.g. to A1:A20) and do this:

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        With ComboBox1
            Dim OrigRange As Range: OrigRange = .ListFillRange
            If Not Application.Intersect(OrigRange, Target) Is Nothing Then
                .ListFillRange = .OrigRange.Resize(OrigRange.Cells(1).End(xlDown).Row - OrigRange.Row + 1)
            End If
        End With
    End Sub

来源：https://stackoverflow.com/questions/52217526/dropdown-list-with-autocomplete-suggestion-in-excel-vba

标签

excel

vba

excel-vba