Excel·VBA多级联动的数据有效性

最新推荐文章于 2024-02-06 18:47:33 发布

薛定谔_51

最新推荐文章于 2024-02-06 18:47:33 发布

阅读量2.3k

点赞数 1

分类专栏： # Excel VBA 文章标签： excel vba

本文链接：https://blog.csdn.net/hhhhh_51/article/details/128679058

版权

Excel 同时被 2 个专栏收录

79 篇文章 78 订阅

订阅专栏

VBA

76 篇文章 28 订阅

订阅专栏

Function val_lv(arr, Optional lv& = 1)
    '数据有效性级别函数，arr为数据有效性的数组，lv为级别，返回第lv级的规则数据；arr建议从表格读取
    '第lv级的内容为便于定义，允许在一个单元格内有多个数据，使用分隔符，默认为","（半角）
    '代码简易，每级避免出现归属不同上级的同名字符串，会出错
    Dim dict As Object, delimiter$, i&, j&, temp, high_lv, result
    delimiter = ","    '分隔符，最好为数据中不存在的字符，如Chr(28)或|
    If LBound(arr) = 0 Then  '转为从1开始计数
        arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))
    End If
    If UBound(arr, 2) < lv Then Debug.Print "级别不能大于数组列数": val_lv = "": Exit Function
    Set dict = CreateObject("scripting.dictionary")
    If lv = 1 Then
        For i = 1 To UBound(arr)
            temp = Split(arr(i, lv), delimiter)
            For Each t In temp
                dict(t) = ""
            Next
        Next
        result = Array(Join(dict.keys, ","), "")
        val_lv = WorksheetFunction.Transpose(result)  'lv=1时，则ubound(val_lv,2)=1
    ElseIf lv > 1 Then
        For i = 1 To UBound(arr)
            high_lv = arr(i, lv - 1)  '第lv级的上一级，字典嵌套
            If Not dict.Exists(high_lv) Then Set dict(high_lv) = CreateObject("scripting.dictionary")
            temp = Split(arr(i, lv), delimiter)
            For Each t In temp
                dict(high_lv)(t) = ""
            Next
        Next
        ReDim result(1 To dict.Count, 1 To 2)  '从1开始计数，返回第lv级的上一级和本级
        For Each k In dict.keys
            j = j + 1: result(j, 1) = k: result(j, 2) = Join(dict(k).keys, ",")
        Next
        val_lv = result  'lv>1时，则ubound(val_lv,2)=2
    End If
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '适用单个单元格选中，多级联动的数据有效性，但上级修改下级不会自动修改
    Dim arr, brr, args_dict As Object, a&, b$, c&
    Set args_dict = CreateObject("scripting.dictionary")  '参数字典
'--------------------参数填写：字典(列号)=级别，列号、级别都为数字
    args_dict(1) = 1: args_dict(2) = 2: args_dict(3) = 3
    arr = Worksheets("数据有效性").[a2:c7].Value: a = Target.Column
    If Not args_dict.Exists(a) Then Debug.Print "范围外": Exit Sub
    For Each k In args_dict.keys
        If args_dict(k) = args_dict(a) - 1 Then c = k - a  '当前选中的上级列号的偏移量
    Next
    If args_dict(a) = 1 Then  '第1级
        brr = val_lv(arr, 1)
        With Target.Validation
            .Delete
            .Add xlValidateList, xlValidAlertStop, xlEqual, Formula1:=brr(1, 1)
        End With
    ElseIf args_dict(a) > 1 And Target.Offset(0, c) <> "" Then
        brr = val_lv(arr, args_dict(a))
        For i = 1 To UBound(brr)
            If brr(i, 1) = Target.Offset(0, c).Text Then b = brr(i, 2): Exit For
        Next
        With Target.Validation
            .Delete
            .Add xlValidateList, xlValidAlertStop, xlEqual, Formula1:=b
        End With
    End If
End Sub