如何用vba在excel单元格中创建根据内容自动减少的数据有效性下拉列表？

在Excel中，在单元格中做下拉列表，是最普遍的一个Excel使用场景。

但是，最近遇到了这么个问题，如下所示

A列是一堆发票号码，D列的单元格中都做了下拉列表，数据来源自A列。

现在要求D列的发票号码每选择一个，下次选择其它单元格时，已经选择过的发票号码不再重复出现在下拉列表中，比如上图中D2已经选择了发票号码【01801028】，那么在D3单元格中出现的下拉列表中不能再出现

【01801028】。

这个问题其实思路很清晰，可以用函数法也可以用VBA。

函数的思路就是构建一列辅助列，根据D列已经选择的发票号码和A列的原始发票号码，做个对比，将未选择的发票号码单列出来，然后下拉列表的数据源指定为辅助列单元格区域即可。

因为要在每次选择D列的发票号码所在的单元格时更新下拉列表的数据源，所以VBA代码应该通过Worksheet_SelectionChange事件触发。

代码如下：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set oDic = CreateObject("Scripting.Dictionary")
    If Target.Count = 1 And Target.Column = 4 Then
        For i = 2 To Me.Range("a65536").End(xlUp).Row
            '通过工作表函数判断是否已经存在，不存在则添加到字典中
            If Excel.Application.WorksheetFunction.CountIf(Target.EntireColumn, Me.Cells(i, "a").Value) = 0 Then
                oDic.Add Me.Cells(i, "a").Value, ""
            End If
        Next i
        arr = oDic.keys
        With Target
            With .Validation
                '先删除之前的数据有效性
                .Delete
                If UBound(arr) >= 0 Then
                    '再添加新的数据有效性下拉列表
                    .Add Type:=xlValidateList, Formula1:=Join(arr, ",")
                End If
            End With
        End With
    End If
End Sub

通过将D列的每个单元格与A列的发票号码做对比，过滤已经开的发票号码，把未开的发票号码装入字典中，然后每次都加载未开的发票号码的数组列表作为数据有效性的下拉列表即可。