Question

我已经制作了一个基于国家和体重计算运输量的样本函数，我希望该国家显示为下拉列表。它与使用Subtotal函数时可以看到的一样，因此用户可以在单元格中输入公式时进行选择。

我已经提到过这个问题并回答：VBA Function argument list select

只有当枚举的参考编号作为第一个参数输入时，该函数才有效，并且它没有取单元格值。

请问：

枚举描述值是否有可能显示为Subtotal函数之类的下拉列表？
第一个参数是否有可能根据分配的用户从单元格中获取值？

以下是示例代码：

Option Explicit
Public Enum nations
    USA = 1
    AU = 2
    CN = 3
    SG = 4
End Enum


Function intlCartage(country As nations, weight As Double)

Select Case country
    Case nations.AU
        intlCartage = 15 + WorksheetFunction.RoundUp((weight - 1), 0) * 10
    Case nations.CN
        intlCartage = 20 + WorksheetFunction.RoundUp((weight - 1), 0) * 5
    Case nations.SG
        intlCartage = 15 + WorksheetFunction.RoundUp((weight - 1), 0) * 10
    Case nations.USA
        intlCartage = 10 + WorksheetFunction.RoundUp((weight - 1), 0) * 8
    Case Else
        intlCartage = "please contact sales for quote."
End Select

End Function

Answer 1

您的选择有限。我知道三种方式，但没有一种方法是好的：

<强> Application.MacroOptions
在代码中添加这样的方法并运行一次

Sub RegisterFunctions()
     Application.MacroOptions "intlCartage", "USA = 1" & vbCrLf & _
                                             "AU = 2" & vbCrLf & _
                                             "CN = 3" & vbCrLf & _
                                             "SG = 4"
End Sub

如果您输入类似=intlCartage(的公式并按 Ctrl - A ，您将在功能帮助中获取说明文字。空间有限，不是很有帮助。 MacroOptions定义中有一个名为MenuText的诱人参数 - 但它会被忽略。

非常复杂的解决方案
在此处阅读更多内容：The quest for the Excel custom function tooltip

数据验证
使用相邻单元格中的内置数据验证功能。

Answer 2

枚举描述值是否可能显示为像小计函数这样的下拉列表？

我不相信，至少根据我的经验。这确实与你的下一个问题有关。

第一个参数是否有可能根据分配的用户从单元格中获取值？

使用数据＆gt;数据工具＆gt;数据验证＆gt;数据验证（键盘快捷键= Alt，D，L），并将值USA,AU,CN,SG作为可用选项列表。然后，您需要string to enumeration converter为您执行自动转换。

我刚刚测试过并且使用两者来提出相同的值。我打电话给您原来的intlCartage，以帮助证明它正在通过枚举。

'Standard Module
Public Function updatedCartage(ByVal country As String, ByVal weight As Double) As Variant
    Dim enumCountry As nations
    Dim nationConverter As NationsConverter
    Set nationConverter = New NationsConverter
    enumCountry = nationConverter.ToEnum(country)

    updatedCartage = intlCartage(enumCountry, weight)
End Function

您将此代码放在类模块中。我已将我的名称重命名为NationsConverter，因为Class1根本不具有描述性。

'For Early binding set a reference to
'Tools>References> "Microsoft Scripting Runtime"
'then use Scripting.Dictionary instead of Object.
'You'd then change where you set the variable to
'New Scripting.Dictionary from CreateObject()
Private StringForEnum As Object
Private EnumForString As Object

Private Sub Class_Initialize()
    PopulateDictionaries
End Sub

Private Sub PopulateDictionaries()
    Set EnumForString = CreateObject("Scripting.Dictionary")
    EnumForString.Add "USA", nations.USA
    EnumForString.Add "AU", nations.AU
    EnumForString.Add "CN", nations.CN
    EnumForString.Add "SG", nations.SG

    Set StringForEnum = CreateObject("Scripting.Dictionary")
    Dim element As Variant
    For Each element In EnumForString.Keys
        StringForEnum.Add EnumForString.Item(element), element
    Next
End Sub

Public Function ToEnum(ByVal value As String) As nations
    value = UCase$(value)

    If Not EnumForString.Exists(value) Then
        ThrowInvalidArgument "ToEnum", value
    End If

    ToEnum = EnumForString(value)
End Function

Public Function ToString(ByVal value As nations)
    If Not StringForEnum.Exists(value) Then
        ThrowInvalidArgument "ToString", CStr(value)
    End If

    ToString = StringForEnum(value)
End Function

Private Sub ThrowInvalidArgument(ByVal source As String, ByVal value As String)
    Err.Raise 5, Information.TypeName(Me) & "." & source, "Invalid input '" & value & "' was supplied."
End Sub

Public Property Get Enums() As Variant
    Enums = EnumForString.Items
End Property

Public Property Get Strings() As Variant
    Strings = EnumForString.Keys
End Property

Answer 3

这种方式使用命名范围，来自this link上接受的答案。

Add_Enums程序只需要执行一次，然后在输入公式时得到一种下拉菜单（虽然输入＆＃34; U＆＃34;因为第一个字母也提供了UPPER作为一个建议）。

Public Sub Add_Enums()

    Dim CountryCode As Collection
    Dim Country As Variant

    Set CountryCode = New Collection


    With CountryCode
        .Add Array("USA", 1)
        .Add Array("AU", 2)
        .Add Array("CN", 3)
        .Add Array("SG", 4)
    End With

    For Each Country In CountryCode
        AllocateNamedRange CStr(Country(0)), CStr(Country(1))
    Next Country

End Sub


Public Function intlCartage(Country As String, weight As Double) As Variant

    Dim lAddition As Long
    Dim lMultiplier As Long

    Select Case Country
        Case 1 'USA
            lAddition = 10
            lMultiplier = 8
        Case 2, 4 'AU or SG
            lAddition = 15
            lMultiplier = 10
        Case 3 'CN
            lAddition = 20
            lMultiplier = 5
        Case Else
            intlCartage = CVErr(xlErrNA)
    End Select

    If IsError(intlCartage) Then
        'Do nothing, it already holds an error.
    Else
        intlCartage = lAddition + WorksheetFunction.Round((weight - 1), 0) * lMultiplier
    End If

End Function

Public Function NamedRangeExists(Book As Workbook, sName As String) As Boolean
    On Error Resume Next
        NamedRangeExists = Book.Names(sName).Index <> (Err.Number = 0)
    On Error GoTo 0
End Function

Public Sub AllocateNamedRange(sName As String, sRefersTo As String, Optional ReferType = "R1C1", _
    Optional Book As Workbook)

    If Book Is Nothing Then
        Set Book = ThisWorkbook
    End If

    With Book
        If NamedRangeExists(Book, sName) Then .Names(sName).Delete
            If ReferType = "R1C1" Then
                .Names.Add Name:=sName, RefersToR1C1:=sRefersTo
        ElseIf ReferType = "A1" Then
                .Names.Add Name:=sName, RefersTo:=sRefersTo
        End If
    End With

End Sub

使VBA函数参数成为用户可供选择的列表

3 个答案: