根据 cmets 和 this mrexcel.com link,似乎 80004005 运行时错误是由于使用 .ListFillRange 来初始化列表框,这将列表框绑定到工作簿中的特定范围并使从列表框中删除任何项目是“非法的”(通过.RemoveItem 或.Clear)。
如果不使用.ListFillRange,则必须手动配置列表框的列。下面是一些可用于文本框的 Change 事件处理程序来完成此操作的代码。此代码有点通用,因此可以轻松调整到任何数据表。此代码的更简单版本只需将列表框的.ColumnWidths 属性设置为硬编码字符串,这基本上将消除对Dim c as Long 之后和Me.ListBox1.Clear 之前的所有代码的需要,但我相信这段代码使列表框更灵活地适应源数据表中的变化...
Private Sub TextBox1_Change()
'To avoid any screen update until the process is finished
Application.ScreenUpdating = False
'This method must make sure to turn this property back to True before exiting by
' always going through the exit_sub label
On Error GoTo err_sub
'This will be the string to filter by
Dim filterSt As String: filterSt = Me.TextBox1.Text & ""
'This is the number of the column to filter by
Const filterCol As Long = 4 'This number can be changed as needed
'This is the sheet to load the listbox from
Dim dataSh As Worksheet: Set dataSh = Worksheets("DataSheet") 'The sheet name can be changed as needed
'This is the number of columns that will be loaded from the sheet (starting with column A)
Const colCount As Long = 6 'This constant allows you to easily include more/less columns in future
'Determining how far down the sheet we must go
Dim usedRng As Range: Set usedRng = dataSh.UsedRange
Dim lastRow As Long: lastRow = usedRng.Row - 1 + usedRng.Rows.Count
Dim c As Long
'Getting the total width of all the columns on the sheet
Dim colsTotWidth As Double: colsTotWidth = 0
For c = 1 To colCount
colsTotWidth = colsTotWidth + dataSh.Columns(c).ColumnWidth
Next
'Determining the desired total width for all the columns in the listbox
Dim widthToUse As Double
'Not sure why, but subtracting 4 ensured that the horizontal scrollbar would not appear
widthToUse = Me.ListBox1.Width - 4
If widthToUse < 0 Then widthToUse = 0
'Making the widths of the listbox columns proportional to the corresponding column widths on the sheet;
' thus, the listbox columns will automatically adjust if the column widths on the sheet are changed
Dim colWidthSt As String: colWidthSt = "" 'This will be the string used to set the listbox's column widths
Dim totW As Double: totW = 0
For c = 1 To colCount
Dim w As Double
If c = colCount Then 'Use the remaining width for the last column
w = widthToUse - totW
Else 'Calculate a proportional width
w = dataSh.Columns(c).ColumnWidth / colsTotWidth * widthToUse
End If
'Rounding to 0 decimals and using an integer to avoid localisation issues
' when converting the width to a string
Dim wInt As Long: wInt = Round(w, 0)
If wInt < 1 And w > 0 Then wInt = 1
totW = totW + wInt
If c > 1 Then colWidthSt = colWidthSt & ","
colWidthSt = colWidthSt & wInt
Next
'Reset the listbox
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = colCount
Me.ListBox1.ColumnWidths = colWidthSt
Me.ListBox1.ColumnHeads = False
'Reading the entire data sheet into memory
Dim dataArr As Variant: dataArr = dataSh.UsedRange
If Not IsArray(dataArr) Then dataArr = dataSh.Range("A1:A2")
'If filterCol is beyond the last column in the data sheet, leave the list blank and simply exit
If filterCol > UBound(dataArr, 2) Then GoTo exit_sub 'Do not use Exit Sub here, since we must turn ScreenUpdating back on
'This array will store the rows that meet the filter condition
'NB: This array will store the data in transposed form (rows and columns inverted) so that it can be easily
' resized later using ReDim Preserve, which only allows you to resize the last dimension
ReDim filteredArr(1 To colCount, 1 To UBound(dataArr, 1)) 'Make room for the maximum possible size
Dim filteredCount As Long: filteredCount = 0
'Copy the matching rows from [dataArr] to [filteredArr]
'IMPORTANT ASSUMPTION: The first row on the sheet is a header row
Dim r As Long
For r = 1 To lastRow
'The first row will always be added to give the listbox a header
If r > 1 And InStr(1, dataArr(r, filterCol) & "", filterSt, vbTextCompare) = 0 Then
GoTo continue_for_r
End If
'NB: The Like operator is not used above in case [filterSt] has wildcard characters in it
' Also, the filtering above is case-insensitive
' (if needed, it can be changed to case-sensitive by changing the last parameter to vbBinaryCompare)
filteredCount = filteredCount + 1
For c = 1 To colCount
'Inverting rows and columns in [filteredArr] in preparation for the later ReDim Preserve
filteredArr(c, filteredCount) = dataArr(r, c)
Next
continue_for_r:
Next
'Copy [filteredArr] to the listbox, removing the excess rows first
If filteredCount > 0 Then
ReDim Preserve filteredArr(1 To colCount, 1 To filteredCount)
Me.ListBox1.Column = filteredArr
'Used .Column instead of .List above, as per advice at
' https://stackoverflow.com/questions/54204164/listbox-error-could-not-set-the-list-property-invalid-property-value/54206396#54206396
End If
exit_sub:
Application.ScreenUpdating = True
Exit Sub
err_sub:
MsgBox "Error " & Err.Number & vbCrLf & vbCrLf & Err.Description
Resume exit_sub 'To make sure that screen updating is turned back on
End Sub
如果不再使用.ListFillRange,则列表框一开始将为空,并且仅在用户开始输入文本框后才会填充。目前,如果用户编辑然后清除文本框,整个数据表将被加载到列表框,但可以通过在重置列表框的代码块后添加 If filterSt = "" Then GoTo exit_sub 轻松更改该行为。
代码尝试通过在开始时将整个数据表读取到内存中来更快地加载数据,而不是一次读取数据表一个单元格。它还避免使用列表框的 .AddItem 方法来一次加载整个列表并绕过该方法的 10 列限制,如 this StackOverflow answer 中所述(如果 @ 的值,10 列限制可能成为问题987654339@以后会增加)。
代码使用 2 个数组。第一个数组将所有数据表行加载到内存中,第二个数组复制满足过滤条件的行。在第二个数组中,行和列被反转,以便可以在最后使用ReDim Preserve 轻松调整其大小(在我们知道要保留在数组中的最终数据行数之后)。需要这种转置是因为ReDim Preserve 只允许您调整最后一个维度的大小,如this StackOverflow answer 中所述。谢谢@T.M.,this StackOverflow answer 的建议!