发布时间 : 星期日 文章Excel VBA_多级动态数据有效性设置实例集锦更新完毕开始阅读
Range(\ Else
Range(\alidateList, , , m 'DiffList(Range(ss)) End If End If
Case Range(\
If Not Range(\ s = 0 e = 0
For i = 2 To u
If Cells(i, 7).Value = Range(\ If Cells(i, 7).Value <> Range(\ e = i - 1 Exit For End If Next
If e = 0 Then e = u
Range(\ Range(\
Range(\ ss = Trim(\ m = DiffList(Range(ss)) If InStr(m, \
Range(\ Else
Range(\ End If End If
Case Range(\
If Not Range(\ For i = 2 To u
If Cells(i, 6).Value = Range(\And Cells(i, 7).Value = Range(\ Range(\ Exit For End If Next End If End Select End Sub
Private Sub Workbook_Open()
Range(\
Range(\xlValidateList, Sheets(1).UsedRange.Rows.Count)) End Sub
, , DiffList(Range(\&
23，2级动态数据有效性
‘2012-11-20
‘http://club.excelhome.net/forum.php?mod=viewthread&tid=946178&page=1#pid6486727 Dim d, Arr, d1
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub
If Target.Column <> 2 And Target.Column <> 3 Then Exit Sub If Target.Row < 2 Then Exit Sub Dim i&, c
Arr = Sheet1.UsedRange If Target.Column = 2 Then
Set d = CreateObject(\ For i = 1 To UBound(Arr, 2)
If Arr(1, i) <> \ Next
With Target.Validation .Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d.keys, \ End With
Target.Offset(0, 1) = \
ElseIf Target.Column = 3 And Target.Offset(0, -1) <> \ Set d1 = CreateObject(\ c = d(Target.Offset(0, -1).Value) d.RemoveAll
For i = 2 To UBound(Arr)
If Arr(i, c) <> \ Next i
With Target.Validation .Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d1.keys, \ End With End If End Sub
24，3级右键动态菜单（字典套字典）
‘http://club.excelhome.net/thread-948085-2-1.html ‘2012-11-25 ‘模块代码
Public D1 As New Dictionary Public D2 As New Dictionary Public D As New Dictionary, k Sub 输入()
Dim cc As CommandBarButton
Set cc = Application.CommandBars.ActionControl Arr = Split(cc.HelpFile, \ ActiveCell = Arr(0)
ActiveCell.Offset(0, 1) = Arr(1) ActiveCell.Offset(0, 3) = Arr(2) ActiveCell.Offset(0, 1).Select End Sub Sub yyaa()
Dim i&, Arr, xx, yy, zz, aa, cp, fl Arr = Sheet1.[a1].CurrentRegion On Error Resume Next For i = 2 To UBound(Arr) If Arr(i, 1) <> \小计\ D(Arr(i, 1)) = \ xx = Arr(i, 1)
yy = Arr(i, 2) & \ zz = Arr(i, 4) & \
cp = Arr(i, 1) & Arr(i, 2)
If D1.Exists(xx) = False Then Set D1(xx) = New Dictionary D1(xx)(yy) = zz
If D2.Exists(cp) = False Then Set D2(cp) = New Dictionary D2(cp)(zz) = \End If Next
k = D.Keys End Sub ‘工作表代码
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub
If Target.Column <> 3 Or Target.Row < 3 Then Exit Sub Target.Offset(0, 1) = \On Error Resume Next Dim k1, k2
Dim i&, j&
Dim Pop() 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)
Set myBtn = Pop(j).Controls.Add(msoControlButton) With myBtn
.Caption = k2(y)
.HelpFile = k(i) & \ .OnAction = \输入\ End With Next Next End With Next
.ShowPopup '显示工具栏 End With
Application.CommandBars(\临时菜单\删除工具栏 End Sub
25，2级动态数据有效性（字典套字典）
‘2013-3-19
‘http://club.excelhome.net/thread-922132-1-1.html
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub
If (Target.Column <> 4 And Target.Column <> 6) Or Target.Row < 2 Then Exit Sub