【问题标题】:Me.ListBox1.Clear produces Run time error '- 2147467259(80004005)': Unspecified errorMe.ListBox1.Clear 产生运行时错误“- 2147467259(80004005)”:未指定的错误
【发布时间】:2020-02-14 07:56:27
【问题描述】:

我们的库存中有 4000 种不同的材料/设备。

我们使用与条形码扫描仪集成的 VBA 库存宏来完成所有库存流程。

借助 VBA 代码(比如说Summary Workbook),我们将所有不同的材料/设备分别汇总到另一个工作簿中。

要查看我们库存中有多少不同的管道和多少米的管道,您应该点击摘要工作簿内的“管道”表。

对于“电气材料”、“法兰”、“管件”、“资产”和其他近 20 个库存组是相同的。

所有的标题都是分开的,它们都是不同的页面作为一个列表。

我还将所有标题(“电气材料”、“法兰”、“管件”、“资产”、“管道”等)列在另一张表中(比如说 数据表)。

主要思想是:将此表用作数据列表。

所有上述操作目的是轻松检查材料/设备数量以及我们库存中有多少不同的产品。但是当您打开“摘要工作簿”时,检查起来很复杂。每个库存组包括至少 150 种不同的材料/设备。

所以我在 Summary Workbook 中创建了另一个工作表,并将其命名为 Main Sheet。 此外,我在其中创建了一个文本框和一个列表框。

我从 (A2:F4214) 中选择 DATA 表 中的所有股票信息,并将它们命名为“DATA”。
因此,当我选择主工作表上的列表框时,我使用“ListFillRange”方法传输所有“DATA”。

我使用 6 列带标题。

1- 数字
2- 条码号
3- 股票组名称
4- 股票名称
5- 库存数量
6- 库存测量(米、件、套、升等)

使用文本框作为搜索框的代码:

Private Sub TextBox1_Change()

Dim i As Long
Me.TextBox1.Text = StrConv(Me.TextBox1.Text, 1)
Me.ListBox1.Clear
For i = 2 To Application.WorksheetFunction.CountA(Sayfa281.Range("D:D"))
a = Len(Me.TextBox1.Text)
If Sayfa281.Cells(i, 4).Value Like "*" & TextBox1.Text & "*" Then
Me.ListBox1.AddItem Sayfa281.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sayfa281.Cells(i, 4).Value
End If
Next i

End Sub

它给了:

运行时错误'- 2147467259(80004005)':
未指定的错误。

当我点击 DEBUG 时,它以黄色显示 Me.ListBox1.Clear

当我在用户窗体中使用上述代码时,它可以工作,但在 Excel 工作表中却没有。

【问题讨论】:

  • 我找到了这个mrexcel.com page。它说,如果您在从范围填充列表框时尝试从列表框中删除项目,则会出现您遇到的错误。您可以尝试不使用ListFillRange 并仅从文本框更改事件中填充列表(即使您必须在开始时将列表留空)?如果这没有帮助,我会尝试更深入地挖掘,看看是否能找到可能有帮助的东西。
  • 非常感谢@NoahBridge。我删除了ListFillRange 区域。它有效,但不是我们想要的方式。实际上,当我删除 ListFillRange 然后我将股票名称写入文本框时;它只是找到股票名称。而不是其他列标题。 1- 编号 2- 条形码编号 3- 库存组名称 5- 库存数量 6- 库存测量(米、件、套、升等) 另一个重要的细节是当我在文本框中写一个库存名称时,我显示相同的产品在列表框内并排命名两次。
  • 哦,好的。由于不再使用ListFillRange,因此必须手动配置列表框的列。此bettersolutions.com page 中的多列 部分显示了如何配置列。本质上,您需要将列表框的列数设置为 6,设置列宽,并添加一行来设置每个列的值(就像您当前为第 4 列设置的行)。您还需要使用不带任何参数的.AddItem(如链接中所示)。如果此评论没有帮助,我将尝试写出实际代码并发布。

标签: excel vba textbox listbox


【解决方案1】:

根据 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 的建议!

【讨论】:

  • 以下帖子中的 cmets 可能会让您了解如何绕过引用的 10 列限制,以及使用列表框的 ►.Column 属性在填充转置维度的数组:c.f. [克服10列限制的数组方法] (stackoverflow.com/questions/54204164/…)
  • 谢谢,@T.M.!我刚刚修改了代码以听取您的建议。现在,不需要使用第三个数组。反转filteredArr 变量中的行,使用ReDim Preserve,然后在最后使用.Column 就像一个魅力!
  • 欢迎您并感谢您的反馈。 *旁注:如果您不处理错误,请尽量避免在当前代码中使用过时的GoTo 命令:-)
  • @T.M.,我理解对 GoTo 命令的厌恶,但在 VBA 循环中模拟 C# 的 continue 时我更喜欢它。我个人讨厌由于缺少Continue For 而导致VBA 强制您通过If 语句添加的可怕的额外缩进,尤其是在有多个“继续”条件的情况下。如果代码看起来更干净并且GoTo 标签以“继续”一词命名,那么我对 GoTo` 的所有教条主义都将消失 :-) 我有时使用的另一个选项是将 For 的主体包裹在 @987654353 周围@ 以便Exit Do 有效地变成continue 语句:-)
  • 如果使用得当,肯定是一个有争议的主题和个人风格问题;就我个人而言,我更愿意避免它不会引导他人和我自己陷入困境(“意大利面条代码”) - c.f. GoTo still considered harmfulWhat is wrong with using GoTo?
【解决方案2】:

对于listbox收缩的bug,你可以做如下。

    ListBox1.Width = 1000
    ListBox1.Height = 800

就在离开潜艇之前。它对我有用。

【讨论】:

  • 您好@Emir 和@macrobook,我在测试代码时没有遇到列表框收缩问题。正如StackOverflow answer 中所解释的那样,这种行为似乎是因为 ListBox 中的 IntegralHeight 属性必须设置为 False。这应该可以避免在代码中设置列表框的尺寸。
【解决方案3】:

对于像我这样的初学者,你无法想象你的帮助有多么值得。

非常感谢。

代码运行良好。 我也应该问你一件小事。

在文本框的每种类型中,我的列表框越来越小
事实仍然是信息相互交织。

我尝试更改代码下面的一些参数,


   '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

我无法实现。 您对此有什么建议吗?

祝你有美好的一天。

【讨论】:

    【解决方案4】:

    感谢@macrobook 和@NoahBridge。

    下面的代码对我有用。

    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("T?mListe") '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 = 1
       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
       ReDim filteredArr(1 To UBound(dataArr, 1), 1 To UBound(dataArr, 2)) '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
               filteredArr(filteredCount, c) = dataArr(r, c)
           Next
    
    continue_for_r:
       Next
    
       'Copy [filteredArr] to a new array with the right dimensions
       If filteredCount > 0 Then
           'Unfortunately, Redim Preserve cannot be used here because it can only resize the last dimension;
           '  therefore, we must manually copy the filtered data to a new array
           ReDim filteredArr2(1 To filteredCount, 1 To colCount)
           For r = 1 To filteredCount
               For c = 1 To colCount
                   filteredArr2(r, c) = filteredArr(r, c)
               Next
           Next
    
           Me.ListBox1.List = filteredArr2
       End If
    
    ListBox1.Height = 750
    ListBox1.Width = 1800
    ListBox1.Top = 100
    
    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
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 2016-07-21
      • 1970-01-01
      • 2020-03-24
      • 2022-07-08
      • 1970-01-01
      • 1970-01-01
      • 2018-06-21
      相关资源
      最近更新 更多