Question

我要在Excel VBA中的列表框中添加10多个列。我不断收到运行时错误'380'-无效的属性值。它可以正常工作，直到列表框中的第9列。我在其他任何地方都找不到合适的解决方案。有人知道该问题的解决方法吗？

Private Sub txtSearch_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal 
Shift As Integer)
Dim rng As Range
Set rng = Range("Lookup")
Dim rw
Dim strText As String
strText = LCase(txtSearch.Text)
With ListBox1
.RowSource = ""
.ColumnCount = 12

 For Each rw In rng.Rows
    If InStr(LCase(Cells(rw.Row, 4)), strText) Then
        .AddItem Cells(rw.Row, 1).Value
        .List(ListBox1.ListCount - 1, 1) = Cells(rw.Row, 2).Value
        .List(ListBox1.ListCount - 1, 2) = Cells(rw.Row, 3).Value
        .List(ListBox1.ListCount - 1, 3) = Cells(rw.Row, 4).Value
        .List(ListBox1.ListCount - 1, 4) = Cells(rw.Row, 5).Value
        .List(ListBox1.ListCount - 1, 5) = Cells(rw.Row, 6).Value
        .List(ListBox1.ListCount - 1, 6) = Cells(rw.Row, 7).Value
        .List(ListBox1.ListCount - 1, 7) = Cells(rw.Row, 8).Value
        .List(ListBox1.ListCount - 1, 8) = Cells(rw.Row, 9).Value
        .List(ListBox1.ListCount - 1, 9) = Cells(rw.Row, 10).Value
        .List(ListBox1.ListCount - 1, 10) = Cells(rw.Row, 11).Value
        .List(ListBox1.ListCount - 1, 11) = Cells(rw.Row, 12).Value
        .List(ListBox1.ListCount - 1, 12) = Cells(rw.Row, 13).Value           
    End If
Next    

End With
End Sub

Answer 1

我不知道这是否可以解决所有问题，但是肯定可以解决。另外，我不确定您要从哪个工作表中提取Cells(rw.Row, 2).value。但是他们可能与它为什么会中途停止有关。另外，要清理一点，请尝试另外使用For Statement。

Private Sub txtSearch_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    Dim rng As Range: Set rng = Range("Lookup")
    Dim rw
    Dim strText As String: strText = LCase(txtSearch.Text)

    With ListBox1
        .RowSource = ""
        .ColumnCount = 21

        For Each rw In rng.Rows
            If InStr(LCase(Cells(rw.Row, 4)), strText) Then
                .AddItem Cells(rw.Row, 1).Value
                For x = 1 To 12  '''Change Worksheet to your Worksheet name
                    .List(ListBox1.ListCount - 1, x) = Worksheets("Sample").Cells(rw.Row, x + 1).Value2
                Next x
            End If
        Next

    End With

End Sub

如果这没有帮助，请尝试@Cyril对数组说的话。

Answer 2

只是回到你身边...有点长，但这是一般的想法...

这一切都包含在ActiveX控件的代码中：

for

所以这里发生了很多事情...由于VIM中的数组重新对齐方式，我使用了两个单独的数组。您只能仅更新数组的第二个元素，因此Option Explicit Sub ListBox1_Click() Dim rw As Range, strtext As String Dim arr As Variant, ai As Long, aj As Long Dim brr As Variant, bi As Long, bj As Long strtext = "a" 'I used this when i did my testing ReDim arr(11, 0) For Each rw In Range("rng") If InStr(LCase(rw.Value), strtext) Then aj = findaj(arr) If Not IsEmpty(arr(1, aj)) Then aj = aj + 1 ReDim Preserve arr(11, aj) End If For ai = 1 To 11 arr(ai, aj) = Cells(rw.Row, ai + 1).Value Next ai End If Next rw ReDim brr(aj, 11) For bi = 0 To aj For bj = 1 To 11 brr(bi, bj) = arr(bj, bi) Next bj Next bi ListBox1.ColumnCount = 11 ListBox1.List = brr End Sub Private Function findaj(ByVal brr As Variant) Dim j As Long, meow As String j = 0 Do While True On Error GoTo toll j = j + 1 meow = brr(1, j) Loop toll: findaj = j - 1 End Function只能在我arr(ai,aj)向数组添加新行时更新aj。 / p>

因此，我们创建了一个数组（redim preserve），该数组根据VBA的限制来捕获数据。在该数组中，我们使用函数arr，该函数有意地捕获错误以确定findaj中适当的最后一个 column （我用斜体表示了对列的使用，因为它不是确实如此，但是从空间上考虑是有意义的。

然后按照适当的列/行顺序将数组arr转换为arr。

然后，您创建brr。

Answer 3

我尝试了以下代码。它在Excel工作表上应用了过滤器，但我不知道如何将数据从Excel工作表传输到列表。我尝试使用Table对象，但没有帮助。

Dim col As Byte
Dim src As Worksheet
Dim tgt As Worksheet
Dim lastRow As Integer
Dim tgt_lastRow As Integer
Dim filterRange As Range
Dim copyRange As Range
Dim j As Integer
Dim db As ListObject
Set db = ActiveSheet.ListObjects("DB_TABLE")

On Error Resume Next

Set src = ThisWorkbook.Sheets("Lookup")
Set tgt = ThisWorkbook.Sheets("TEMP")
src.AutoFilterMode = False
lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
Set filterRange = src.Range("A1:ad" & lastRow)
Set copyRange = src.Range("A2:ad" & lastRow)
filterRange.AutoFilter field:=4, Criteria1:=Me.txtSearch.Value
tgt.Range("a1:ae1000").Clear
copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.Range("A2")
tgt.Range("A1", tgt.Range("ae10000").End(xlDown)).Sort 
Key1:=tgt.Range("B1"), 
order1:=xlAscending, Header:=xlYes
src.Range("A1:ZZ1").Copy
tgt.Range("A1:ZZ1").PasteSpecial xlPasteFormats
tgt.Range("A1:ZZ1").PasteSpecial xlPasteFormulas
tgt_lastRow = tgt.Range("A" & 10000).End(xlUp).Row
Me.ListBox1.List = db

我们可以解决这个问题吗？

如何修复Excel VBA中的“运行时错误380”？

3 个答案: