Question

在合并的单元格（名为SelName）中，我有一个下拉列表，其中包含100多个项目。搜索列表效率不高，因为此列表在不断增长。因此，我想要一个带有自动完成/建议功能的下拉列表。我拥有的代码之一是在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

首先，我尝试在一个空白表（仅包含下拉列表）中对其进行测试，并且效果很好。但是，一旦我尝试将此代码插入另一个工作表中，它就不会。有谁知道可能是什么问题？仅供参考：我在此工作表中有几个下拉列表，并且所有这些列表都在合并的单元格中。此外，我还有其他一些私人订阅...

Answer 1

为什么要这样做，而不仅仅是创建ComboBox控件并设置ListFillRange和LinkedCell而没有任何代码？

发生错误是因为您正在编辑的范围（Target）没有任何验证。您应该添加检查支票：

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

编辑

如果我正确理解了该问题，则需要一个可从列自动填充并在列中键入更多条目时自动更新的ComboBox。不需要这种复杂的代码。您可以简单地添加一个ComboBox（例如ComboBox1），设置其ListFillRange（例如为A1:A20），然后执行以下操作：

    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

Excel VBA中具有自动完成/建议的下拉列表

1 个答案: