当前位置: 首页 > >

Excel 2010 VBA 入门 085 数据处理之制作多级下拉列表

发布时间:

目录


示例


代码


? ? 添加一个隐藏工作表


在查询表中添加事件



示例

? ? 如图所示,该表为某公司的员工工资数据。现希望建立一个查询表,在查询表中建立二级下拉列表,可供选择部门以及部门内的员工。该如何用VBA实现?


员工编号姓名部门基本工资
0006程建华管理部2875
0009李国敏管理部3050
0016袁志刚财务部3523
0017周汉林管理部2890
0018骈永富管理部2850
0020孙玉梅管理部2580
0023陈亚菁管理部3460
0026康小芸销售部1800
0028刘晨市场部5318
0042齐光市场部5425
0052于健惠管理部4320
0060王文群销售部1875
0066曾国安市场部4726
0068程光华销售部1850
0072刘志峰管理部1385
0080刘玉录管理部6700

?


代码

? ? 使用一个隐藏的工作表用以存储下拉列表的项目,使用Selection_Change事件来触发下拉列表的生成程序。当选中“部门”单元格时,程序从原始数据的部门列中提取不重复的值存放至隐藏工作表中,然后设置该单元格的数据有效性为该列表;当选中“姓名”单元格时,从原始数据区域的姓名列表中选择“部门”单元格值的数据,并存放至隐藏工作表中,然后设置该单元格的数据有效性为该列表。


? ? 添加一个隐藏工作表
部门?姓名
管理部?袁志刚
财务部?毛传阳
销售部?姚胜
市场部??
总经办??
人事部??

在查询表中添加事件

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rowData As Long
Dim rowNew As Long
Dim shtData As Worksheet
Dim shtTemp As Worksheet
Dim sDept As String

Set shtData = Sheets("sheet1")
Set shtTemp = Sheets("sheet3")

Select Case Target.Address
Case "$A$3"
shtData.Range("C:C").Copy shtTemp.Range("A1")
shtTemp.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
Target.Validation.Delete
With shtTemp
Target.Validation.Add _
xlValidateList, _
Formula1:="=" & .Name & "!" & .Range("A2:A" & .Range("A1").CurrentRegion.Rows.Count).Address
End With
Case "$B$3"
sDept = Target.Offset(0, -1).Value
Target.Value = ""
rowNew = 2
With shtTemp
.Range("C2:C" & .Range("C2").CurrentRegion.Rows.Count).Clear
End With
For rowData = 2 To shtData.Range("A1").CurrentRegion.Rows.Count
If shtData.Cells(rowData, "C").Value = sDept Then
shtTemp.Cells(rowNew, "C").Value = shtData.Cells(rowData, "B").Value
rowNew = rowNew + 1
End If
Next rowData
Target.Validation.Delete
With shtTemp
Target.Validation.Add _
xlValidateList, _
Formula1:="=" & .Name & "!" & .Range("C2:C" & .Range("C1").CurrentRegion.Rows.Count).Address
End With
End Select
End Sub

?


?



友情链接: