在Excel中創建組合框以過濾

Question

新增功能爲stackoverflow。我在工作中使用VBA，並在完成我的任務時遇到問題。我想創建一個宏，它在Excel工作表中創建一個組合框，然後查找用戶選擇了哪個單元並將該列的數據提供給組合框。如果我用2個宏來做（1.創建梳子2.喂數據）工作正常。如果我試圖將他們團結在一個不起作用。找不到組合框。 問題是行：Sheet1.ComboBox1.AddItem值 這是我的代碼。感謝您提供任何幫助

Global mycellCl As String 
Sub CreateComboBox1() 
'first part 
Lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row 

With ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _ 
       Link:=False, DisplayAsIcon:=False, Left:=250, Top:=10, Width:=100, _ 
       Height:=20) 
End With 
myvalue = "" 
'end sub 
'2nd part works fine as 2nd macro FeedData() 
Dim Lrow As Long, test As New Collection 
Dim Value As Variant, temp() As Variant 
ReDim temp(0) 

mycellCl = Mid(Application.ActiveCell.Address, 2, 1) 
'Lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row 

On Error Resume Next 
temp = Sheet1.Range(mycellCl & "2:" & mycellCl & Lastrow).Value 
For Each Value In temp 
    If Len(Value) > 0 Then test.Add Value, CStr(Value) 
Next Value 
If Sheet1.Shapes.Count > 0 Then 
For Each Value In test 
    Sheet1.ComboBox1.AddItem Value 
Next Value 
End If 
On Error GoTo 0 
Set test = Nothing 
End Sub 

Answer 1

您不能將該組合框作爲Sheet1類的成員引用，因爲它在編譯時不存在。簡單的解決方案是存儲對您添加的組合框的引用並使用該變量：

Sub CreateComboBox1() 
    Dim cbo     As Object 
    'first part 
    Lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row 

    Set cbo = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _ 
             Link:=False, DisplayAsIcon:=False, Left:=250, Top:=10, Width:=100, _ 
             Height:=20).Object 
    myvalue = "" 
    'end sub 
    '2nd part works fine as 2nd macro FeedData() 
    Dim Lrow As Long, test As New Collection 
    Dim Value As Variant, temp() As Variant 
    ReDim temp(0) 

    mycellCl = Mid(Application.ActiveCell.Address, 2, 1) 
    'Lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row 

    On Error Resume Next 
    temp = Sheet1.Range(mycellCl & "2:" & mycellCl & Lastrow).Value 
    For Each Value In temp 
     If Len(Value) > 0 Then test.Add Value, CStr(Value) 
    Next Value 
    If Sheet1.Shapes.Count > 0 Then 
     For Each Value In test 
      cbo.AddItem Value 
     Next Value 
    End If 
    On Error GoTo 0 
    Set test = Nothing 
End Sub