|
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, ",")
- 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
复制代码 |
|