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

问题描述 投票：5回答：6

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

= rNames（REGS）

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

= REGNAMES

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

{= REGNAMES}

并将其拖到几个单元格的右边，rNames函数将忠实地返回

选项＃1 |选项＃2 | ...

即，该函数返回预期的范围。

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

谢谢。

PS：rNames以可变形式返回结果范围，如果有任何影响。

excel vba excel-vba
6个回答
8
投票

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

  • 直接在“来源”字段中输入的实际清单

  • 文字范围引用（例如$ 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'。您的问题尚不清楚，但这可能是整个答案中唯一对您重要的部分。如果尝试返回范围引用时未使用“设置”，则VBA会返回范围的值，不能将其用作验证列表。

3
投票

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

可以应用验证规则的任何范围都可以以编程方式应用该规则。因此，如果要将规则应用于单元格A1，则可以执行以下操作：

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

上面添加了一个单元格内的下拉验证，其中包含项“ 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

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

0
投票

类似rNames函数的声音可能返回一维数组（将被视为行）。尝试使函数以基于1的二维数组的形式返回一列（Ansa（1,1），然后是Ansa（2,1）等）

0
投票

您不是要使用dynamic range names吗？这很容易，不需要任何vba。

0
投票

为了未来：

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

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
0
投票

@@ 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://stackoverflow.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
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.