|
楼主 |
发表于 2024-3-11 09:26
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
这个有点高级,我有点没看懂,如果我把数据改到其他列,只能实现一级下拉,带不出第二级来
Private Sub Worksheet_SelectionChange(ByVal T As Range)
Dim arr, i&
If T.Column > 3 Or T.Row = 1 Or T.Address(0, 0) Like "*:*" Then Exit Sub
Set dic = CreateObject("scripting.dictionary")
arr = Sheet2.Range("C1").CurrentRegion
For i = 3 To UBound(arr)
If Not dic.exists(arr(i, 3)) Then
Set dic(arr(i, 3)) = CreateObject("scripting.dictionary")
End If
dic(arr(i, 3))(arr(i, 4)) = Empty
Next
With T.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(dic.keys, ",")
End With
End Sub
Private Sub Worksheet_Change(ByVal T As Range)
If T.Column > 1 Or T.Row = 1 Or T.Address(0, 0) Like "*:*" Then Exit Sub
With T.Offset(0, 1).Validation
If dic.exists(T.Value) Then
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(dic(T.Value).keys, ",")
Else
MsgBox "查无此值"
End If
End With
Set dic = Nothing
End Sub
|
|