[英]Excel VBA: Adding Array to Form Control Combobox
我有几个文件要与一个结果文件合并和分析。 其中一个文件包含重复次数未知的不同名称的样本。 我想从此文件中提取所有未知名称并将它们添加到下拉框(表单控件组合框)。
为了简化事情,我将以下字符串添加到新 Excel 文件中工作表的第一列:
字符串 1
字符串 1
字符串 2
字符串 3
字符串 3
字符串 3
字符串 4
字符串 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
不幸的是,此代码导致以下错误:
运行时错误 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:需要对象
谁能解释一下为什么这两件事中的任何一件都是错误的? 非常感谢!
我已经测试了你的代码和我的观察如下:
DropDown 形状不喜欢数组索引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
请试试这个:
ws.Shapes("dropdown_row" & TC.Row).OLEFormat.Object.List = myArray
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.