EXCEL下拉列表逐步筛选实例
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
选实例。
'发布：
'*******************************************
Const KhRan As String = &uot;B11:D11,B5:C6,D7,C9:D9,B13:B15,D14&uot; '激活单元格地址,可为多个单元格与区域
Const CsSh As String = &uot;数据&uot; '数据所在工作表
Const CsRan As String = &uot;A2&uot; '数据所在开始第一单元格地址
Const MinH As Integer = &uot;18&uot; '列表框最小高度
Const MinW As Integer = &uot;75&uot; '列表框最小宽度
Private Sub SjCob_Click()
'功能：列表框单击时,赋值
'修改：10-06-03 15:38
ActiveCell = SjCob.Value
End Sub
Private Sub SjCob_GotFocus()
'功能：列表框获得焦点时,获得清单
'修改：10-06-03 15:38
Dim eRan As Range
Dim Arr
Set eRan = Worksheets(CsSh).Cells(Cells.Rows.Count, Range(CsRan).Column).End(xlUp) Arr = Worksheets(CsSh).Range(CsRan & &uot;:&uot; & eRan.Address)
With SjCob
.List = WorksheetFunction.Transpose(Arr)
.DropDown
End With
End Sub
Private Sub SjCob_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) '功能：列表框输入时,动态显示清单
'修改：10-06-03 15:38
Dim Arr()
Dim i As Integer
Dim tStr As String
Dim SjRan As Range
Dim tRan As Range
Set tRan = Worksheets(CsSh).Cells(Cells.Rows.Count, Range(CsRan).Column).End(xlUp) Set SjRan = Worksheets(CsSh).Range(CsRan & &uot;:&uot; & tRan.Address)
If KeyCo