Excel VBA_多级动态数据有效性设置实例集锦.docVIP

1，3级动态数据有效性（字典+数组） ‘/viewthread.php?tid=461616pid=3017249page=2extra=page%3D1 xls ‘3 级都做了不重复处理，只用一个工作表选择变化事件。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count 1 Then Exit Sub If Target.Column 2 And Target.Column 3 And Target.Column 1 Then Exit Sub Dim d, i, Myr, Arr Set d = CreateObject(Scripting.Dictionary) Myr = Sheet1.[a65536].End(xlUp).Row Arr = Sheet1.Range(a2:c Myr) If Target.Column = 1 Then Set d = CreateObject(Scripting.Dictionary) For i = 1 To UBound(Arr) d(Arr(i, 1)) = Next With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d.keys, ,) ‘.Add 3, 1, 1, Join(d.keys, ,) End With Target.Offset(0, 1) = Target.Offset(0, 2) = Set d = Nothing ElseIf Target.Column = 2 And Target.Offset(0, -1) Then Set d = CreateObject(Scripting.Dictionary) For i = 1 To UBound(Arr) If Arr(i, 1) = Target.Offset(0, -1).Text Then d(Arr(i, 2)) = End If Next i With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d.keys, ,) aa End With Target.Offset(0, 1) = Set d = Nothing ElseIf Target.Column = 3 And Target.Offset(0, -1) Then Set d = CreateObject(Scripting.Dictionary) bb = Cells(Target.Row, 1) | Cells(Target.Row, 2) For i = 1 To UBound(Arr) If Arr(i, 1) | Arr(i, 2) = bb Then d(Arr(i, 3)) = End If Next i With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d.keys, ,) End With Set d = Nothing End If End Sub 2，3级动态数据有效性（数组） ‘下拉菜单设置1019.xls ‘/viewthread.php?tid=487842page=1#pid3237573 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count 1 Then Exit Sub If Target.Column 2 And