Excel中的dynamic下拉列表

我的数据是这样安排的:

A B
1 ABC 说明1
2 XYZ 描述2
3 MNO 说明3
4 ABC 说明4
5 MNO 描述5

现在在单元格A1中的另一个工作表中,应该有一个基于上面的列A的下拉列表。 点击它ABC,XYZ和MNO将显示在下拉菜单中。 那么当我select,例如在A1的ABC; 在B1中,两个描述(描述1和描述4)将显示在下拉列表中。

我写了这个连接所有匹配的函数:

Public Function ConcatMatches(ByRef rgFind As Range, ByRef rgSource As Range, ByVal lngOffset As Long) As String Dim rgHit As Range, firstAddress As String, noWrap As Boolean Set rgHit = rgSource.Find(rgFind.Value) 'ensure no wrapping occurs to avoid infinite loops firstAddress = rgHit.Address noWrap = True Dim concat As String While Not (rgHit Is Nothing) And noWrap If concat <> "" Then concat = concat & ", " End If concat = concat & rgHit.Offset(0, lngOffset) 'find next and ensure we didn't wrap back to first hit Set rgHit = rgSource.Find(rgFind.Value, rgHit) noWrap = (firstAddress <> rgHit.Address) Wend ConcatMatches = concat End Function 

而这个函数只显示一个范围内的唯一值(用于数据validation),将其input为数组公式+使用dynamic命名范围。 我展示了如何在下面使用它们:

 Public Function GetUniques(rgList As Range) As Variant 'prepare return array matching calling range dimensions Dim CallerRows As Long, CallerCols As Long, CallerAddr As String Dim RowNdx As Long, ColNdx As Long, v As Variant With Application.Caller CallerRows = .Rows.Count CallerCols = .Columns.Count End With Dim Result() As Variant: ReDim Result(1 To CallerRows, 1 To CallerCols) 'fill with result with blank strings For RowNdx = 1 To CallerRows For ColNdx = 1 To CallerCols Result(RowNdx, ColNdx) = "" Next ColNdx Next RowNdx 'filter out uniques Dim dict As Variant: Set dict = CreateObject("Scripting.Dictionary") For Each v In rgList.Cells dict(v.Value) = 1 Next v 'push uniques to first column of resulting array RowNdx = 1 For Each v In dict.Keys() Result(RowNdx, 1) = v RowNdx = RowNdx + 1 Next v GetUniques = Result End Function 
  1. input公式,如下图所示,然后按CTRL + SHIFT + ENTER

输入公式

  1. 使用CTRL + F3打开名称pipe理器,并使用以下公式=OFFSET(Sheet4!$C$2,0,0,MATCH("*",Sheet4!$C$2:$C$6,-1),1)

动态命名的范围

  1. 使用dynamic命名范围作为数据validation列表:

数据验证与唯一代码

  1. 按预期工作:

最后结果

注意 :对于input的值,数组公式不是dynamic的,可能需要更新以匹配添加附加行时的行数 – 切记在更新范围时始终按CTRL + SHIFT + ENTER

UDF作为数组公式input:

UDF作为数组公式输入

请检查我的方法:

  1. 数据不需要sorting
  2. 支持多对多的关系
  3. 没有VBA
  4. 没有命名的范围
  5. 事先不需要知道独特的项目名称或数量

在新标签中打开图片看到更好:

在Sheet1(数据表)中: 在这里输入图像说明
按照公式: 在这里输入图像说明

在Sheet2(帮手表)中: 在这里输入图像说明
按照公式:
在这里输入图像说明

在Sheet3(结果表)中: 在这里输入图像说明