PKKO

回復 20# GBKEE


    感謝超版大大,但如此的話,會太複雜,因為我有非常多個都需要下拉式選單

每一個下拉式選單都要搭配一個textbox 可能暫不考慮

還是先捨去逐字篩選的功能,而選擇只能用第一個字篩選好了

GBKEE

回復 21# PKKO

下載 (97.23 KB)

2014-12-6 13:49

1. Option Explicit
   
2. Dim UserComboBox() As New Class1
   
3. Private Sub UserForm_Initialize() '表單初始化的事件
   
4.     Dim e As Control, i As Integer
   
5.     For Each e In Me.Controls
   
6.         If InStr(e.Name, "ComboBox") Then
   
7.             ReDim Preserve UserComboBox(0 To i)
   
8.             Set UserComboBox(i).xlComBox = e
   
9.             i = i + 1
   
10.         End If
    
11.     Next
    
12. End Sub
    
13. Private Sub CommandButton1_Click()
    
14.     Unload Me   '關閉表單
    
15. End Sub

複製代碼

[ Class1 ] (物件類別模組)的程式碼

1. Option Explicit
   
2. Public WithEvents xlComBox As MSForms.ComboBox
   
3. Private Sub xlComBox_DropButtonClick()  '按下ComboBox下拉箭頭按鈕
   
4.     Dim i As Long, S As String, Name1 As String, Arr As Variant
   
5.     If xlComBox.ListIndex > -1 Then Exit Sub
   
6.     'ComboBox的值,不在ComboBox.List的清單中選取的: ComBox.ListIndex=-1
   
7.     S = UCase(Trim(UserForm1.TextBox1))
   
8.     For i = 1 To Range("A65536").End(xlUp).Row
   
9.         If UCase(Range("A" & i)) Like S & "*" And S <> "" Then
   
10.             Name1 = Name1 & "," & Range("A" & i)
    
11.         End If
    
12.     Next
    
13.     Arr = Split(Mid(Name1, 2), ",")
    
14.     With xlComBox
    
15.         If UBound(Arr) > -1 Then
    
16.             .List = Arr
    
17.             .Value = Arr(0)
    
18.         Else
    
19.             .Clear
    
20.         End If
    
21.         .DropDown
    
22.     End With
    
23. End Sub

複製代碼

PKKO

回復 22# GBKEE

哇,小弟沒看過這個東西,研究一下先,感謝大大!

stillfish00

回復 23# PKKO
新增物件類別模組 clsComboBox

1. Private WithEvents mComboBox As MSForms.ComboBox
   
2. 
   
3. Public Sub InitialControl(ByRef oControl)
   
4.   Set mComboBox = oControl
   
5. End Sub
   
6. 
   
7. Private Sub mComboBox_Change()
   
8.   mComboBox.Clear
   
9. End Sub
   
10. 
    
11. Private Sub mComboBox_DropButtonClick()
    
12.   Dim ar, i As Long, j As Long
    
13.   ar = Application.Transpose(Range([A1], [A1].End(xlDown)))
    
14.   For i = 1 To UBound(ar)
    
15.     If ar(i) Like mComboBox.Text & "*" Then
    
16.       j = j + 1
    
17.       ar(j) = ar(i)
    
18.     End If
    
19.   Next
    
20.   
    
21.   If j > 0 Then
    
22.     ReDim Preserve ar(1 To j)
    
23.     mComboBox.List = ar
    
24.   End If
    
25. End Sub

複製代碼

UserForm:

1. Private gcolComboBoxs As Collection
   
2. 
   
3. Private Sub UserForm_Initialize()
   
4.   Dim oComboBox As clsComboBox, x
   
5.   
   
6.   Set gcolComboBoxs = New Collection
   
7.   
   
8.   For Each x In Me.Controls
   
9.     If StrComp(TypeName(x), "ComboBox", vbTextCompare) = 0 Then
   
10.       Set oComboBox = New clsComboBox
    
11.       oComboBox.InitialControl x
    
12.       gcolComboBoxs.Add oComboBox
    
13.     End If
    
14.   Next
    
15. End Sub

複製代碼

PKKO

回復 22# GBKEE

感謝超版大大的用心
小弟也想到了一個方法可以解決這個問題
使用DropButtonClick就不會有這個問題了
已可成功解決,非常感謝超版大大