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

If D3.Exists(fl) = False Then Set D3(fl) = New Dictionary D3(fl)(aa) = \

If D4.Exists(xh) = False Then Set D4(xh) = New Dictionary D4(xh)(bb) = \Next

k = D.Keys End Sub

‘sheet1中代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub '如果选择区域则退出 If Target.Column <> 1 Or Target.Row < 2 Then Exit Sub On Error Resume Next

Dim sht As Worksheet, k1, k2, k3, k4 Set sht = Sheets(\库存\Dim i&, j&

Dim Pop() As CommandBarPopup Dim Pop1() As CommandBarPopup Dim Pop2() As CommandBarPopup

Call yyaa

With Application.CommandBars.Add(\临时菜单\ With .Controls.Add(Type:=msoControlButton) .Caption = \请选择\ .FaceId = 136 End With

For i = 0 To UBound(k) k1 = D1(k(i)).Keys

With .Controls.Add(msoControlPopup, 1, , , 1) .BeginGroup = True .Caption = k(i)

For j = 0 To UBound(k1)

k2 = D2(k(i) & k1(j)).Keys

ReDim Preserve Pop(j) As CommandBarPopup

Set Pop(j) = .Controls.Add(msoControlPopup, , , , True) Pop(j).Caption = k1(j) For x = 0 To UBound(k2)

k3 = D3(k(i) & k1(j) & k2(x)).Keys

ReDim Preserve Pop1(x) As CommandBarPopup

Set Pop1(x) = Pop(j).Controls.Add(msoControlPopup, , , , True) Pop1(x).Caption = k2(x) For y = 0 To UBound(k3)

k4 = D4(k(i) & k1(j) & k2(x) & k3(y)).Keys ReDim Preserve Pop2(y) As CommandBarPopup

Set Pop2(y) = Pop1(x).Controls.Add(msoControlPopup, , , , True) Pop2(y).Caption = k3(y) For z = 0 To UBound(k4)

Set myBtn = Pop2(y).Controls.Add(msoControlButton) With myBtn

.Caption = k4(z)

.HelpFile = k(i) & \ .OnAction = \输入\ .FaceId = 70 + z End With Next Next Next Next End With Next

.ShowPopup '显示工具栏 End With

Application.CommandBars(\临时菜单\删除工具栏 End Sub

19，3级动态数据有效性（字典+数组+合并单元格）

‘http://www.excelpx.com/thread-223000-1-1.html ‘20120217

Public Myr&, d, k, Arr

Private Sub Worksheet_selectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column <> 7 Then Exit Sub If Target.Row < 2 Then Exit Sub Dim alist$, i&

Myr = Sheet1.[a65536].End(xlUp).Row Arr = Sheet1.Range(\

Set d = CreateObject(\For i = 1 To UBound(Arr) d(Arr(i, 1)) = \Next

k = d.keys

alist = Join(k, \

With Target.Validation .Delete

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=alist End With

Target.Offset(0, 1) = \

Target.Offset(0, 2) = \End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub

If Target.Column <> 8 And Target.Column <> 7 Then Exit Sub If Target.Row < 2 Then Exit Sub Dim aa$, bb$

If Target <> \

If Target.Column = 7 Then For i = 1 To UBound(Arr)

If Arr(i, 1) = Target.Value Then d(Arr(i, 2)) = \ End If Next i Else

Target.Offset(0, 1) = \ For i = 1 To UBound(Arr)

If Arr(i, 2) = Target.Value And Arr(i, 1) = Target.Offset(0, -1).Value Then d(Arr(i, 3)) = \ End If Next i End If k = d.keys

If d.Count > 1 Then

With Target.Offset(0, 1).Validation .Delete

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d.keys, \ End With Else

Target.Offset(0, 1) = k(0) End If

d.RemoveAll End If End Sub

‘http://club.excelhome.net/thread-654547-2-1.html

有2列是合并单元格的情况

Public Myr&, d, Arr, d1, d2

Private Sub Worksheet_selectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column <> 12 Then Exit Sub If Target.Row < 2 Then Exit Sub Dim i&

Myr = Sheet17.Cells(Rows.Count, 4).End(xlUp).Row Arr = Sheet17.Range(\

Set d = CreateObject(\For i = 2 To UBound(Arr)

If Arr(i, 2) <> \Next

With Target.Validation .Delete

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d.keys, \ End With

Target.Offset(0, 1).Resize(1, 2) = \End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target = \If Target.Row < 2 Then Exit Sub Dim n, n1, m&, j&

Set d1 = CreateObject(\Set d2 = CreateObject(\

If Target.Column = 12 Then For i = 2 To UBound(Arr)

If Arr(i, 2) <> \ Next

n = d(Target.Value)

If Sheet17.Cells(n, 2).MergeCells Then

m = Sheet17.Cells(n, 2).MergeArea.Count For j = n To n + m - 1

If Arr(j, 3) <> \ Next Else

d1(Arr(n, 3)) = n