如何自动扩展下拉列表验证列表

Question

有没有替代SendKeys自动扩展下拉列表验证列表？我想在点击一个单元格后展开下拉列表验证列表。我的问题的焦点完全在于如何避免使用SendKeys方法。

以下是使用SendKeys的正常工作解决方案：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If HasValidation(Target) Then
        SendKeys "%{DOWN}"
        SendKeys "{NUMLOCK}", True 'Workaround for Numlock turn off bug
    End If
End Sub

Function HasValidation(MyCell As Range) As Boolean
    Dim t: t = Null
    On Error Resume Next
    t = MyCell.Validation.Type
    On Error GoTo 0
    HasValidation = Not IsNull(t)
End Function

相关链接： HasValidation功能：https://stackoverflow.com/a/31346246/1903793 NumLock bug：https://stackoverflow.com/a/29551913/1903793

上面的代码顺利运行顺利。对于广泛报道的问题，我只是对SendKeys有偏见。我怀疑将此解决方案合并到更大的代码中可能会导致将来出现意外行为，这可能很难捕获。

Answer 1

您对要实现的目标的定义留下了一些问题需要解答，但下面的代码可能会让您走上正确的道路。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Const Trigger As String = "A3:B4"               ' modify to suit
    Const ValCell As String = "H3"                  ' modify as required

    Dim ValType As Long

    If Not Application.Intersect(Target, Range(Trigger)) Is Nothing Then
        Application.EnableEvents = False
        Range(ValCell).Activate

        On Error Resume Next
        ValType = ActiveCell.Validation.Type
        On Error GoTo 0
        If ValType = 3 Then SendKeys "%{DOWN}"

        Application.EnableEvents = True
    End If
End Sub

上述程序监视触发范围A3：B4，您可以根据需要进行调整。如果单击此范围中的一个单元格（可能是单个单元格区域），则单击具有验证的单元格中的下拉列表（定义为ValCell），只要它存在，就会展开。该代码通过激活CellVal单元来实现此目的。