VBA自学应用（1）——二级数据有效性

现在有两列这样的数据，我们要将它做成如下效果

我们该如何做到呢？请见如下代码

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Columns("C:D")) Is Nothing Then Exit Sub
    Dim d As Object
    Dim arr, brr, ss, c
    Dim i As Long, j As Long, m As Long, k As Integer
    Set d = CreateObject("scripting.dictionary")
    '创建字典
    arr = Range("a2:b" & Cells(Rows.Count, 2).End(3).Row)
    '数据入数组
    For i = 1 To UBound(arr)
        For j = i + 1 To UBound(arr)
            If j = UBound(arr) Then GoTo 10
            '最后一个记录特殊处理
            If arr(j, 1) <> "" Then '记录下一个非空记录所在位置
10:
                ReDim brr(1 To j - i)
                'brr存字典item
                For m = i To j - 1
                    k = k + 1
                    brr(k) = arr(m, 2)
                Next
                '元素赋值给数组brr
                ss = Join(brr, ",")
                d(arr(i, 1)) = ss
                '字典存对应元素
                Exit For
            End If
        Next
        i = j - 1
        k = 0
    Next
    If Target.Column = 3 Then
        '设置C列有效性
        With Target.Validation
            .Delete
            .Add xlValidateList, xlValidAlertStop, Formula1:=Join(d.keys, ",")
        End With
    Else
        '设置D列有效性
        If Target.Offset(, -1) <> "" Then
            c = Target.Offset(, -1).Value
        Else
            Target.Validation.Delete
            Target.ClearContents
            Exit Sub
        End If
        With Target.Validation
            .Delete
            .Add xlValidateList, xlValidAlertStop, xlBetween, d(c)
        End With
    End If
    Set d = Nothing
End Sub

这样的效果并不难，但是他为我们解放双手不是提供了很大的助力吗！