我可以使用 VBA 函数将可接受值的（动态）列表返回到 Excel 的数据验证中吗？

Posted 2023-04-19

【中文标题】我可以使用 VBA 函数将可接受值的（动态）列表返回到 Excel 的数据验证中吗？

【英文标题】：Can I use VBA function to return a (dynamic) list of acceptable values into Excel's data validation?

【发布时间】：2011-01-24 14:19:52

【问题描述】：

对于给定的单元格，我选择数据/验证并将允许设置为“列表”。我现在希望像这样设置 Source：

=rNames(REGS)

但这不起作用（未找到名称）。所以我通过简单地分配上面的公式（没有单元格范围）来插入/命名/定义并创建“REGNAMES”。然后我返回到数据/验证，当我像这样设置源时：

=注册名称

现在我得到“源当前评估为错误”。不幸的是，即使我忽略它，这个错误也不会消失。我可以像这样在工作表中创建一个范围公式：

=REGNAMES

将它拖到右边穿过几个单元格，rNames 函数会忠实地返回

选项#1 |选项 #2 | ...

也就是说，该函数按预期返回一个范围。

我知道我可以使用宏代码从 VBA 中操作该单元格的列表设置。我不太喜欢这些副作用。我更喜欢建立在函数上的干净的依赖树。任何想法如何让数据/验证接受从 rNames 返回的数组值？

谢谢。

PS：rNames 将结果范围作为 Variant 返回，如果这有任何影响的话。

【问题讨论】：

请发布您的 rNames 代码...并解释 rNames(REGS) 中的 REGS 是什么

【参考方案1】：

我认为问题在于数据验证对话框只接受以下“列表”：

直接输入源字段的实际内容列表

文字范围引用（如 $Q$42:$Q$50）

本身解析为范围引用的命名公式

最后一个是关键 - 没有办法让 VBA 函数只返回一个可用于验证的数组，即使您从命名公式调用它也是如此。

您可以编写一个返回范围引用的 VBA 函数，然后从命名公式调用 that。作为以下技术的一部分，这可能很有用，可以近似地做你真正想做的事情。

首先，在某处有一个实际范围，可以调用您的任意数组返回 VBA UDF。假设你有这个功能：

Public Function validationList(someArg, someOtherArg)

    'Pretend this got calculated somehow based on the above args...
    validationList = Array("a", "b", "c")
End Function

您将其从 $Q$42:$Q$50 作为数组公式调用。您将获得三个单元格，其中包含“a”、“b”和“c”，其余单元格将出现 #N/A 错误，因为返回的数组小于调用 UDF 的范围。到目前为止一切顺利。

现在，有另一个 VBA UDF，它只返回范围的“占用”部分，忽略 #N/A 错误单元格：

Public Function extractSeq(rng As Range)

    'On Error GoTo EH stuff omitted...

    'Also omitting validation - is range only one row or column, etc.

    Dim posLast As Long
    For posLast = rng.Count To 1 Step -1
        If Not IsError(rng(posLast)) Then
            Exit For
        End If

        If rng(posLast) <> CVErr(xlErrNA) Then
            Exit For
        End If
    Next posLast

    If posLast < 1 Then
        extractSeq = CVErr(xlErrRef)
    Else
        Set extractSeq = Range(rng(1), rng(posLast))
    End If
End Function

然后您可以从命名公式中调用它，如下所示：

=extractSeq($Q$42:$Q$50)

命名公式将返回一个范围引用，Excel 将接受一个允许的验证列表。笨重，但无副作用！

注意上面代码中关键字“Set”的使用。您的问题尚不清楚，但这可能是整个答案中唯一对您重要的部分。如果在尝试返回范围引用时不使用“Set”，VBA 将改为返回范围的值，它不能用作验证列表。

【讨论】：

我还没试过这个。我觉得它可能会起作用，但正如你所说，它很笨重。我不喜欢必须搁置固定范围的电子表格单元格——人们永远不知道最大值应该是多少（并且搁置一整列/行是低效的）。不过，这是迄今为止最好的答案。我会考虑...

有效。我留出整个工作表只是为了将验证列表转换为连续范围（使用您的方法）。不理想，但是……不管是什么？谢谢你的想法。

【参考方案2】：

我刚刚对访问 Shapes 下拉控件的内容进行了一些研究，并发现了另一种解决此问题的方法，您可能会觉得有帮助。

可以应用验证规则的任何范围都可以通过编程方式应用该规则。因此，如果您想对单元格 A1 应用规则，您可以这样做：

ActiveSheet.Range("A1").Validation.Add xlValidateList, , , "use, this, list"

上面添加了一个单元内下拉验证，其中包含“使用”、“此”和“列表”项。如果您覆盖Worksheet_SelectionChange() 事件，并检查其中的特定范围，您可以调用任意数量的例程来创建/删除验证规则。这种方法的美妙之处在于引用的列表可以是任何可以在 VBA 中创建的列表。我需要一个动态生成的工作簿中不断变化的工作表子集的列表，然后我将其连接在一起以创建验证列表。

在Worksheet_SelectionChange() 事件中，我检查范围，如果匹配，则触发验证规则子，因此：

Private Sub Worksheet_SelectionChange(ByVal Target as Range)

    If Target.Address = "$A$1" Then
        UpdateValidation
    End If

End Sub

UpdateValidation() 中的验证列表生成器代码执行以下操作：

Public Sub UpdateValidation()

    Dim sList as String
    Dim oSheet as Worksheet

    For Each oSheet in Worksheets
        sList = sList & oSheet.Name & ","
    Next

    sList = left(sList, len(sList) -1)  ' Trim off the trailing comma

    ActiveSheet.Range("A1").Validation.Delete
    ActiveSheet.Range("A1").Validation.Add xlValidateList, , , sList

End Sub

现在，当用户单击下拉箭头时，他/她将看到更新的验证列表。

【讨论】：

优秀而简单的解决方案。我很快就会发布一个完整的工作示例 xls。其他问题：列表项的数量是否有限制？以及如何处理items中的“,”字符？

非常好的解决方案。但是缺点是 sList-String 的最大长度为 255 个字符。较长的字符串被截断（在 Excel 2003 中测试，32 位）。

【参考方案3】：

听起来您的 rNames 函数可能返回一个一维数组（将被视为一行）。 尝试让您的函数将一列作为基于 1 的二维数组返回（Ansa(1,1) 然后 Ansa(2,1) 等）

【讨论】：

你猜对了，但是改变结果数组的方向对结果没有影响——它不起作用。

【参考方案4】：

您不能使用dynamic range names 吗？这很简单，不需要任何 vba。

【讨论】：

我将此问题解释为想要动态更改验证列表的内容，而不仅仅是适应列表大小的更改。

不，这不起作用，因为列表项不在连续范围内。谢谢。

【参考方案5】：

为了未来：

随后在命名范围中使用以下内容，并将命名范围设置为“数据验证”“列表”值

Function uniqueList(R_NonUnique As Range) As Variant

    Dim R_TempList As Range
    Dim V_Iterator As Variant
    Dim C_UniqueItems As New Collection

    On Error Resume Next
    For Each V_Iterator In R_NonUnique
        C_UniqueItems.Add "'" & V_Iterator.Parent.Name & "'!" & V_Iterator.Address, CStr(V_Iterator.Value2)
    Next V_Iterator
    On Error GoTo 0

    For Each V_Iterator In C_UniqueItems
        If R_TempList Is Nothing Then
            Set R_TempList = Range(V_Iterator)
        End If
        Set R_TempList = Union(R_TempList, Range(V_Iterator))
    Next V_Iterator

    Set uniqueList = R_TempList

End Function

【参考方案6】：

@user5149293 我非常感谢您的代码，但我建议在添加重复值时防止集合引发错误。在数据验证列表或 Name-Manager-Formula 中使用自定义公式会阻止代码使用 vbe 调试器，这使得在此处追溯错误非常困难（我自己遇到了这个问题，在使用您的代码时） . 我建议使用单独的函数检查集合中是否存在键：

    Function uniqueList(R_NonUnique As Range) As Variant
    'Returns unique list as Array

        Dim R_TempList As Range
        Dim V_Iterator As Variant
        Dim C_UniqueItems As New Collection

        For Each V_Iterator In R_NonUnique
           'Check if key already exists in the Collection
           If Not HasKey(C_UniqueItems, V_Iterator.Value2) Then
              C_UniqueItems.Add Item:="'" & V_Iterator.Parent.Name & "'!" & V_Iterator.Address, Key:=CStr(V_Iterator.Value2)
           End If
        Next V_Iterator

        For Each V_Iterator In C_UniqueItems
            If R_TempList Is Nothing Then
                Set R_TempList = Range(V_Iterator)
            End If
            Set R_TempList = Union(R_TempList, Range(V_Iterator))
        Next V_Iterator

        Set uniqueList = R_TempList

    End Function


    Function HasKey(coll As Collection, strKey As String) As Boolean
    'https://***.com/questions/38007844/generic-way-to-check-if-a-key-is-in-a-collection-in-excel-vba
        Dim var As Variant
        On Error Resume Next
        var = coll(strKey)
        HasKey = (Err.Number = 0)
        Err.Clear

    End Function