带下拉列表的VBA自定义Excel功能

Question

我在Excel（VBA）中有自定义函数，但我正在尝试在CELL函数中执行类似该列表的操作：

尝试使用Excel：

  

= CELL（info_type [然后会出现下拉列表]

所以，我想：

  

= MyFunction（my_variable [和我的自定义下拉列表]

列表应该出现在Excel中，而不是VBA窗口中。

有人知道怎么做吗？

抱歉，我无法发布图片。

Answer 1

这是一种可行的笨重方法。我们的想法是使用Worksheet_Change事件捕获您输入函数的不完整版本的实例，在该阶段，单元格上显示动态数据验证下拉列表，为您提供完成功能。然后，再次使用Worksheet_Change，检测完成的版本，将其转换为公式，并删除数据验证。

作为概念证明 - 我编写了sin版本，允许用户选择“度数”或“弧度”：

Function Sine(ParamArray args() As Variant) As Variant
    On Error GoTo err_handler
    If args(1) = "Degrees" Then
        Sine = Sin(args(0) * Application.WorksheetFunction.Pi() / 180)
    Else
        Sine = Sin(args(0))
    End If
    Exit Function
err_handler:
    Sine = "=Sine(" & args(0) & ","
End Function

如果用户至少没有给出角度，则会抛出未被捕获的错误。

然后，在我使用的Worksheet_Change中：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim choices As String, angle As String, tval As String

    On Error GoTo err_handler
    tval = Target.Value
    If tval Like "=Sine(*," Then
        angle = Mid(tval, 7)
        angle = Left(angle, Len(angle) - 1) 'get rid of comma
        choices = angle & " Degrees, " & angle & " Radians"
        Target.Validation.Add xlValidateList, Formula1:=choices
        Target.Select
    ElseIf tval Like "* Degrees" Then
        Target.Validation.Delete
        Target.Formula = "=Sine(" & Val(tval) & ", ""Degrees"")"
        Target.Offset(1).Select
    ElseIf tval Like "* Radians" Then
        Target.Validation.Delete
        Target.Formula = "=Sine(" & Val(tval) & ", ""Radians"")"
        Target.Offset(1).Select
    End If
err_handler:
End Sub

它的工作原理如下。在A1（比如）中键入=Sine(45并按Enter键。您将看到以下内容（点击下拉箭头后）：

然后，选择例如“45度”A1中的公式变为

=sine(45, "Degrees")

并显示值（0.707107），并且已删除数据验证。

可能更灵活的想法的变体是通过单元格显示用户表单，而不是依赖于此数据验证黑客。