|
HI，大家好，我是星光。 之前給大家分享了如何使用函數(shù)制作模糊匹配的下拉菜單，但函數(shù)那家伙的特點(diǎn)是小巧靈，數(shù)據(jù)量稍大，效率就直接彌留之際了。眾所周知，在Excel里，高效率解決復(fù)雜問(wèn)題，還是得靠又傻又愣的VBA。那么，今天就再給大家分享一下，如何使用VBA制作更好用的動(dòng)態(tài)模糊匹配下拉菜單。 完成后的效果演示如下： 如上圖所示，點(diǎn)擊A列單元格，Excel會(huì)自動(dòng)跳出一個(gè)文本輸入框和一個(gè)列表框。當(dāng)在文本框中輸入數(shù)據(jù)時(shí)，列表框的數(shù)據(jù)會(huì)隨之動(dòng)態(tài)更新。 1 丨 制作步驟 選中目標(biāo)工作表，在【開(kāi)發(fā)工具】→【插入】→【ActiveX控件】，先后插入一個(gè)文本框和一個(gè)列表框?？丶拇笮『痛娣诺奈恢枚茧S意，反正這事你說(shuō)了也不算，后面代碼會(huì)自己做調(diào)整。  需要注意的是，如果你不會(huì)調(diào)整VBA代碼，那么此處文本框的名字必須為T(mén)extBox1，列表框的名字必須為L(zhǎng)istBox1——正常而言，這倆名字也都是系統(tǒng)默認(rèn)的。  保持目標(biāo)工作表選中狀態(tài)不變，按快捷鍵<Alt+F11>打開(kāi)VBE編輯器，將以下代碼粘貼到當(dāng)前工作表的代碼窗口。 '設(shè)置文本框和列表框的大小及位置Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim b As Boolean, arr If Target.Column <> 1 Or Target.Row < 2 Then b = True '如果用戶選擇的單元格不是第1列或者屬于第1行 If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then b = True '如果用戶選擇的單元格數(shù)量大于1 If b Then ListBox1.Visible = False '不可見(jiàn) TextBox1.Visible = False '不可見(jiàn) Exit Sub '退出程序 End If With Worksheets('示例') '下拉列表來(lái)源內(nèi)容的所在工作表 arr = .Range('d2:d' & .Cells(Rows.Count, 'd').End(3).Row) '數(shù)據(jù)源 End With With TextBox1 .Value = '' .Visible = True '可見(jiàn) .Top = Target.Top '文本框頂部位置 .Left = Target.Left '文本框左側(cè)位置 .Height = Target.Height '文本框高度 .Width = Target.Width '文本框?qū)挾?/span> .Activate '激活文本框 End With With ListBox1 .Visible = True '可 .Top = Target.Offset(0, 1).Top .Left = Target.Offset(0, 1).Left .Height = Target.Height * 5 .Width = Target.Width .List = arr '寫(xiě)入數(shù)據(jù)源數(shù)據(jù) End WithEnd Sub'根據(jù)文本框的輸入值動(dòng)態(tài)匹配數(shù)據(jù)Private Sub TextBox1_Change() Dim arr, brr, i&, k& With Worksheets('示例') '下拉列表來(lái)源內(nèi)容的所在工作表 arr = .Range('d2:d' & .Cells(Rows.Count, 'd').End(3).Row) '數(shù)據(jù)源 End With If TextBox1.Text = '' Then ListBox1.List = arr: Exit Sub ReDim brr(1 To UBound(arr)) For i = 1 To UBound(arr) If InStr(1, arr(i, 1), TextBox1.Text, vbTextCompare) Then '忽略字母大小寫(xiě) k = k + 1 brr(k) = arr(i, 1) End If Next ListBox1.List = brr '寫(xiě)入匹配后的數(shù)據(jù)End Sub'如果雙擊列表框的內(nèi)容則寫(xiě)入活動(dòng)單元格Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ActiveCell = ListBox1.Text With ListBox1 .Clear '清空列表框 .Visible = False End With With TextBox1 .Value = '' .Visible = False End WithEnd Sub最后關(guān)閉VBE，將當(dāng)前工作簿另存為xlsm文件即可。 …… 2 丨 其它 如果你不懂VBA，按以上步驟操作后，需要將代碼中的'示例'替換為下拉列表數(shù)據(jù)源所在的工作表名，將'd2:d' & .Cells(Rows.Count, 'd')部分，替換為實(shí)際數(shù)據(jù)源所在列。
打個(gè)響指，蓋木歐瓦，下期再見(jiàn)。 |
|
|
來(lái)自： hercules028 > 《excel》
