Question

我正在编写vba代码，它将针对工作表中的整个列搜索所有列表框项目。如果在Excel工作表列中找不到列表框项，我想从列表中删除该项。我尝试了几个代码，它显示一些错误为“无法获取列表属性，无效的属性数组索引”。以下是我目前使用的代码。

 gsubfn('([-0-9.]+)', ~round(exp(as.numeric(x)),4), Labs1)
 #[1] "(0.0983,2.6912]"           "(2.6912,72.2404]"         
 #[3] "(72.2404,1958.629]"        "(1958.629,54176.3638]"    
 #[5] "(54176.3638,1468864.1897]"


 exp(as.data.frame(t(sapply(strsplit(Labs1, '[^-0-9.]+'), 
             function(x) as.numeric(x[-1])))))
 #           V1           V2
 #1 9.827359e-02 2.691234e+00
 #2 2.691234e+00 7.224044e+01
 #3 7.224044e+01 1.958629e+03
 #4 1.958629e+03 5.417636e+04
 #5 5.417636e+04 1.468864e+06

知道我在这段代码中出错了。

Answer 1

您应该从列表的最后一项迭代到第一项，因为删除项会更改其索引。

尝试改变你的循环：

    For intItem = ListBox1.ListCount - 1 To 0 Step -1
        If IsInArray(ListBox1.List(intItem), myarray) Then
        Else
            ListBox1.RemoveItem intItem
        End If
    Next

我有一个与您的任务相关的提示，但不完全与您所描述的错误有关。

对于这种类型的任务，你应该使用Dictionary类型的对象而不是迭代数组 - 它会更有效。

我修改了你的代码以使用字典。检查它并比较每个解决方案完成此任务所需的时间 - 带字典的那个应该快得多。如果您对此代码有任何疑问，请在评论中告诉我。

Private Sub CommandButton1_Click()
    Dim myArray As Variant
    Dim intItem As Long
    Dim dict As Object
    Dim i As Long
    Dim value As Variant


    '--- [Loading data into dictionary] ------------------------------------
    Set dict = VBA.CreateObject("Scripting.Dictionary")
    myArray = Sheet1.Range("A2:A1000")

    'Iterate through all the items in array and load them into dictionary.
    For i = LBound(myArray) To UBound(myArray)

        value = myArray(i, 1)

        If Not IsEmpty(value) Then
            If Not dict.exists(value) Then
                Call dict.Add(value, 0)
            End If
        End If
    Next i
    '-----------------------------------------------------------------------



    '--- [Comparing ListBox with dictionary] -------------------------------
    With ListBox1
        For intItem = .ListCount - 1 To 0 Step -1
            value = .List(intItem)

            If Not dict.exists(value) Then
                .RemoveItem intItem
            End If

        Next
    End With
    '-----------------------------------------------------------------------

End Sub

如果在VBA中找不到匹配项，则删除列表框项

1 个答案: