Excel VBA：添加数组以形成控件combobox

我有几个文件，我想结合和分析一个结果文件。 其中一个文件包含具有不同名称的样本，这些样本会重复未知次数。 我想从这个文件中提取所有未知名称，并将它们添加到下拉框（Form Control Combobox）中。

为了简化事情，我在新的Excel文件的第一列添加了以下string：

string1

string1

string2

string3

string3

string3

string4

string4

为了提取唯一的string，我写了下面这段代码：

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 

不幸的是，这段代码导致了下面的错误：

运行时错误1004：无法设置Dropdown类的List属性

我不明白我的数组有什么问题，因为如果我改变最后一行

 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 

但那给了我：

运行时错误424：所需的对象

有人可以解释为什么这两件事情是错的吗？ 非常感谢！

Answer 1

我已经testing了你的代码和我的观察结果如下：

DropDown形状不喜欢您的数组的索引0的Empty值。 看起来你不能在你传递给.List方法的数组中使用混合types，因为即使我将Empty值更改为一个整数，它也会失败，并出现相同的错误。

关于为什么这个声明有效：

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

上面的工作，因为你传递一个数组，避免了上面提到的陷阱，因为你显式不传递Empty值。

注意：严格地说，当i_UnStr = 0时，你不需要ReDim你的数组，所以你可以用这种方式来处理数组。

或者，你可以强制一个空string到第一个数组项，这应该工作：

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

所以，解决方法是避免混合的数据types（也可能是数组中不必要的空元素），或者如果需要“空白”，则需要将其分配为空stringvbNullString或文字"" 。

就优化而言，如果数据量很大，我会避免使用这个数组，因为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