Excel VBA 多级菜单（利用单元变动事件）

先去重复，再取唯一值做序列

Sub test001()

Dim qhs01 As Range

Dim n As Long

Dim qhn01 As Long

Dim xulie1 As String

 

 

With Sheets("角色表")

qhn01 = .Range("b1000000").End(xlUp).Row

n = 1

For Each qhs01 In .Range("b2:b" & qhn01)

If Application.WorksheetFunction.CountIf(.Range("$b$2:" & qhs01.Address), qhs01) = 1 Then

xulie1 = xulie1 & qhs01 & ","

' .Cells(n, 1) = qhs01

n = n + 1

End If

Next

End With

 

For i = 3 To 1003

With Sheets("用户设置").Range("f" & i).Validation

.Delete

.Add Type:=xlValidateList, Formula1:=xulie1

End With

Next

End Sub

 

先去重复，再取唯一值做序列

 

实际运用 选的时候增加二级菜单，选好二级菜单是添加二级菜单后面的描述

Private Sub Worksheet_Change(ByVal Target As Range)

Dim qhn01, qhn02 As Long 'qhn01获取当前选中单元格行,qhn02获取角色表最后一行有数据的单元格行

Dim i As Long

Dim QH_xuelie01 As String '序列变量

 

qhn02 = Sheets("角色表").Range("b1000000").End(xlUp).Row

qhn01 = ActiveCell.Row

 

If Target.Column = 6 Then

'qhn01 = ActiveCell.Row

If Sheets("用户设置").Range("f" & qhn01) <> "" Then

For i = 2 To qhn02

If Sheets("角色表").Range("b" & i) = Sheets("用户设置").Range("f" & qhn01) Then

QH_xuelie01 = QH_xuelie01 & Sheets("角色表").Range("c" & i) & ","

End If

Next

Else

Sheets("用户设置").Range("g" & qhn01).Validation.Delete

Sheets("用户设置").Range("g" & qhn01).ClearContents

Exit Sub

End If

 

With Sheets("用户设置").Range("g" & qhn01).Validation

.Delete

.Add Type:=xlValidateList, Formula1:=QH_xuelie01

End With

Else

If Target.Column = 7 Then

'qhn01 = ActiveCell.Row

If Sheets("用户设置").Range("g" & qhn01) <> "" Then

Sheets("用户设置").Range("h" & qhn01) = Application.WorksheetFunction.VLookup(Sheets("用户设置").Range("g" & qhn01), Sheets("角色表").Range("c2:d" & qhn02), 2, 0)

Else

Sheets("用户设置").Range("h" & qhn01).ClearContents

Exit Sub

End If

End If

End If

End Sub

 

实际运用 选的时候增加二级菜单，选好二级菜单是添加二级菜单后面的描述