Excel VBA：將數組添加到窗體控件Combobox

Question

我有幾個文件要與一個結果文件合併和分析。其中一個文件包含具有不同名稱的樣本，這些樣本會重複未知次數。我想從該文件中提取所有未知名稱，並將它們添加到下拉框（Form Control Combobox）中。

爲簡單起見，我添加以下字符串到第一列中一個新的Excel文件中的片材：

String 1

String 1

String 2

String 3

String 3

String 3

String 4

String 4

提取唯一的字符串，我寫了下面的代碼段：

Sub MakeArrayInDropDown() 
    ' Declare variables 
    Dim myArray() As Variant ' Array with undefined size 
    Dim i As Integer   ' Counter for-loop 
    Dim i_UnStr As Integer  ' Counter of unique strings 
    Dim i_lastStr As Integer ' Length of strings in column A 
    Dim wb As Workbook   ' Short workbookname 
    Dim ws As Worksheet   ' Short worksheet name 
    Dim TC As Range    ' Target Cell (TC) 

    ' Set workbook and worksheet 
    Set wb = ThisWorkbook 
    Set ws = ActiveSheet 

    ' Set cell where all unique strings should go to 
    Set TC = ws.Cells(1, 3) 

    ' Determine amount of strings in column A 
    i_lastStr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 

    ' Go through all strings that are in column A 
    For i = 1 To i_lastStr 

     ' Save the first string in the first position of the array 
     If i_UnStr = 0 Then 
      i_UnStr = 1 
      ReDim myArray(i_UnStr)      ' Resize array to 1 
      myArray(i_UnStr) = ws.Cells(i, 1)   ' Add first string to array 

     ' Add if next string is different from the string previously added 
     ElseIf Not StrComp(myArray(i_UnStr), ws.Cells(i, 1)) = 0 Then 
      ' Increase unique strings counter 
      i_UnStr = i_UnStr + 1 
      ' Resize array to no unique strings, preserving precious values 
      ReDim Preserve myArray(i_UnStr) 
      ' Add next unique string to array as well 
      myArray(i_UnStr) = ws.Cells(i, 1) 
     End If 
    Next i 

    ' Add Form Control dropdown to target cell 
    ws.DropDowns.Add(TC.Left, TC.Top, TC.Width, TC.Height).Name = "dropdown_row" & TC.Row 
    wb.Worksheets("Sheet1").Shapes("dropdown_row" & TC.Row).ControlFormat.List = myArray 
End Sub 

不幸的是，在下面的錯誤該代碼的結果：

Runtime error 1004: Unable to set the List property of the Dropdown class

我不明白我因爲如果我改變最後一行爲

wb.Worksheets("Sheet1").Shapes("dropdown_row" & TC.Row).ControlFormat.List = _ 
    Array(myArray(1), myArray(2), myArray(3), myArray(4)) 

一切工作完全正常。這似乎是我的數組是不能接受這樣...

而且，最初我寫的最後一行這樣

ws.Shapes("dropdown_row" & TC.Row).ControlFormat.List = myArray 

但是，這給了我：

Runtime error 424: object required

可有人給我解釋一下爲什麼這兩件事中的任何一件都是錯的？非常感謝！

Answer 1

我測試你的代碼，我的看法如下：

下拉形狀不喜歡你的數組的索引0的Empty值。看起來你不能在傳遞給.List方法的數組中使用混合類型，因爲即使我將Empty值更改爲整數，它也會失敗，並顯示相同的錯誤。

至於爲什麼這個語句的工作：

wb.Worksheets("Sheet1").Shapes("dropdown_row" & TC.Row).ControlFormat.List = _ 
Array(myArray(1), myArray(2), myArray(3), myArray(4)) 

上述工作，因爲你傳遞的是避免上述陷阱，因爲你明確不傳遞Empty值的數組。

注：嚴格地說，沒有必要爲你ReDim您的數組時i_UnStr = 0，陣列通常基數爲0，所以你可以使用它的方式。

備選地，可以強制空字符串到第一陣列的項目，這應該工作：

myArray(0) = vbNullString 
ws.Shapes("dropdown_row" & TC.Row).ControlFormat.List = myArray 

因此，該解決方案是避免混合數據類型（也可能在不必要的空元素數組），或者如果您需要「空白」，則需要將其分配爲空字符串vbNullString或文字""。

就優化而言，如果數據量很大，我會避免使用陣列，因爲ReDim Preserve通常是一個相當昂貴的語句。

Sub MakeArrayInDropDown() 
    ' Declare variables 
    Dim i As Integer   ' Counter for-loop 
    Dim i_lastStr As Integer ' Length of strings in column A 
    Dim wb As Workbook   ' Short workbookname 
    Dim ws As Worksheet   ' Short worksheet name 
    Dim TC As Range    ' Target Cell (TC) 
    Dim DD As Shape    ' Dropdown shape 
    ' Set workbook and worksheet 
    Set wb = ThisWorkbook 
    Set ws = ActiveSheet 

    ' Set cell where all unique strings should go to 
    Set TC = ws.Cells(1, 3) 

    ' Determine amount of strings in column A 
    i_lastStr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 

    ' Add Form Control dropdown to target cell 
    Set DD = ws.DropDowns.Add(TC.Left, TC.Top, TC.Width, TC.Height) 
    DD.Name = "dropdown_row" & TC.Row 
    DD.AddItem "" 'Adds a blank entry in the first row of the dropdown 
    DD.AddItem ws.Cells(i,1).Value 
    For i = 2 To i_lastStr 
     ' Add if next string is different from the string previously added 
     ElseIf Not StrComp(ws.Cells(i-1, 1), ws.Cells(i, 1)) = 0 Then 
      DD.AddItem ws.Cells(i, 1).Value 
     End If 
    Next i 

End Sub