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

Can I use VBA function to return a (dynamic) list of acceptable values into Excel's data validation?

提问by Ollie2893

For a given cell, I select Data/Validation and set Allow to "List". I now wish to set Source like so:

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

=rNames(REGS)

=rNames(REGS)

but that does not work (name not found). So I go Insert/Name/Define and create "REGNAMES" by simply assigning the formula above (no cell range). I then return to the Data/Validation and when I set Source like so:

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

=REGNAMES

= REGNAMES

Now I get "Source currently evaluates to error". Unfortunately, this error does not go away even after I ignore it. I can create a range formula in the sheet like so:

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

{=REGNAMES}

{=REGNAMES}

and drag this to the right across a couple cells and the rNames function faithfully returns

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

Option #1 | Options #2 | ...

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

That is, the function returns a range as intended.

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

I know that I can use macro code to manipulate the List setting for that cell out of VBA. I don't like these side-effects much. I would prefer a clean dependency tree built on functions. Any ideas how to get the Data/Validation to accept the array values returned from rNames?

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

Thanks.

谢谢。

PS: rNames returns the result range as a Variant, if that has any bearing.

PS：rNames 将结果范围作为 Variant 返回，如果它有任何意义的话。

回答by jtolle

I think the problem is that data validation dialog only accepts the following "lists":

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

• an actual list of things entered directly into the Source field

• a literal range reference (like $Q$42:$Q$50)

• a named formula that itself resolves to a range reference

• 直接输入 Source 字段的实际事物列表

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

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

That last one is key - there is no way to have a VBA function just return an array that can be used for validation, even if you call it from a named formula.

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

You canwrite a VBA function that returns a range reference, though, and call thatfrom a named formula. This can be useful as part of the following technique that approximates the ability to do what you actually want.

不过，您可以编写一个返回范围引用的 VBA 函数，并从命名公式中调用该函数。这可以用作以下技术的一部分，该技术近似于执行您实际想要的操作的能力。

First, have an actual range somewhere that calls your arbitrary-array-returning VBA UDF. Say you had this function:

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

Public Function validationList(someArg, someOtherArg)

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

And you called it from $Q$42:$Q$50 as an array formula. You'd get three cells with "a", "b", and "c" in them, and the rest of the cells would have #N/A errors because the returned array was smaller than the range that called the UDF. So far so good.

你从 $Q$42:$Q$50 调用它作为数组公式。你会得到三个带有“a”、“b”和“c”的单元格，其余的单元格会出现 #N/A 错误，因为返回的数组小于调用 UDF 的范围。到现在为止还挺好。

Now, have another VBA UDF that returns just the "occupied" part of a range, ignoring the #N/A error cells:

现在，有另一个 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

You can then call this from a named formula like so:

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

=extractSeq($Q:$Q)

and the named formula will return a range reference that Excel will accept an allowable validation list. Clunky, but side-effect free!

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

Note the use of the keyword 'Set' in the above code. It's not clear from your question, but this might be the only part of this whole answer that matters to you. If you don't use 'Set' when trying to return a range reference, VBA will instead return the valueof the range, which can't be used as a validation list.

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

回答by marc russell

I was just doing some research on accessing the contents of a Shapes dropdown control, and discovered another approach to solving this problem that you might find helpful.

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

Any range that can have a validation rule applied can have that rule applied programmatically. Thus, if you want to apply a rule to cell A1, you can do this:

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

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

The above adds an in-cell dropdown validation that contains the items "use," "this," and "list." If you override the Worksheet_SelectionChange()event, and check for specific ranges within it, you can call any number of routines to create/delete validation rules. The beauty of this method is that the list referred to can be any list that can be created in VBA. I needed a dynamically-generated list of an ever-changing subset of the worksheets in a workbook, which I then concatenated together to create the validation list.

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

In the Worksheet_SelectionChange()event, I check for the range and then if it matches, fire the validation rule sub, thus:

在这种情况Worksheet_SelectionChange()下，我检查范围，然后如果匹配，则触发验证规则子，因此：

Private Sub Worksheet_SelectionChange(ByVal Target as Range)

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

End Sub

The validation list-builder code in UpdateValidation()does this:

中的验证列表构建器代码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

And now, when the user clicks the dropdown arrow, he/she will be presented with the updated validation list.

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

回答by user5149293

For the future:

为将来：

Following is then used in a named range and the named range set as the 'Data Validation' 'List' value

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

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

回答by MarcelloIce

@user5149293 I higly appreciate your code, but I recommend to prevent the collection from throwing an error, when adding duplicate values. The usage of a custom formula in the data validation list or in Name-Manager-Formula prevents the code from using the vbe debugger, which makes it very hard to trace back errors here (I ran into this problem myself, when using your code). I recommend to check the existence of key in the collection with a separate function:

@ 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

回答by Charles Williams

Sounds like your rNames function is probably returning a 1-dimensional array (which will be treated as a row).
Try making your function return a column as a 1-based 2-dimensional array (Ansa(1,1) then Ansa(2,1) etc)

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

回答by Patrick Honorez

Couln't you rather use dynamic range names? That's quite easy and does not require any vba.

你不能更喜欢使用动态范围名称吗？这很容易，不需要任何 vba。