|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub Worksheet_SelectionChange(ByVal Target As Range)
n = Sheets("分值字典_获奖").Cells(Rows.Count, "a").End(xlUp).Row
arr = Sheets("分值字典_获奖").Range("b2:f" & n)
Set 区域 = Range("e6:i100000")
On Error Resume Next
' If InStr(Target.Address, ":") Then
' Exit Sub '如果区域多选退出程序
' End If
If Not Intersect(Target, 区域) Is Nothing Then '如果有交集,那么执行
' If Intersect(Target, 区域) Is Nothing Then '如果没有交集 那么执行
With Target.Validation
.Delete
If Target.Column = 5 Then
'选择区域的列号=5列,那么本级列号=1'用自定义函数 用字典设置数据有效性 提取字典下面的第一级菜单
s = 多级下拉菜单(arr, 1)
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=s
ElseIf Target.Column = 6 And Target.Offset(0, -1) <> "" Then
'选择区域的列号=6列,那么本级列号=2'用自定义函数 用字典设置数据有效性 提取字典下面的第二级菜单
s = 多级下拉菜单(arr, 2, Target.Offset(0, -2) & Target.Offset(0, -1), 1)
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=s
ElseIf Target.Column = 7 And Target.Offset(0, -1) <> "" Then
'选择区域的列号=7列,那么本级列号=3'用自定义函数 用字典设置数据有效性 提取字典下面的第三级菜单
s = 多级下拉菜单(arr, 3, Target.Offset(0, -2) & Target.Offset(0, -1), 2)
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=s
ElseIf Target.Column = 8 And Target.Offset(0, -1) <> "" Then
'选择区域的列号=8列,那么本级列号=4'用自定义函数 用字典设置数据有效性 提取字典下面的第四级菜单
s = 多级下拉菜单(arr, 4, Target.Offset(0, -2) & Target.Offset(0, -1), 3)
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=s
ElseIf Target.Column = 9 And Target.Offset(0, -1) <> "" Then
'选择区域的列号=9列,那么本级列号=5'用自定义函数 用字典设置数据有效性 提取字典下面的第五级菜单
s = 多级下拉菜单(arr, 5, Target.Offset(0, -2) & Target.Offset(0, -1), 4)
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=s
End If
End With
Else
Exit Sub
End If
End Sub
Function 多级下拉菜单(arr, 本级列号, Optional 上级 = "", Optional 上级列号 = 1)
'arr 多级下来带单的 数据源 数组
'本级列号 是多级菜单的数据源列号
'上级 是作用选择区域的上一列中的内容,上一个单元格
'上级列号 是作用选择区域的上一列
'作用区域上级单元格的内容=数据源arr,本级列号的上一列
Set dic = CreateObject("scripting.dictionary")
If 上级 = "" Then
For i = 1 To UBound(arr)
dic(arr(i, 本级列号)) = "" '利用item 的唯一性
Next i
Else
For i = 1 To UBound(arr)
If arr(i, 上级列号 - 1) & arr(i, 上级列号) = 上级 Then
dic(arr(i, 本级列号)) = ""
End If
Next i
End If
多级下拉菜单 = IIf(dic.Count > 0, Join(dic.keys, ","), "")
End Function
|
|