Question

我正在处理包含竞争数据的报告，并且试图删除D列中的单元格与另一张工作表中指定的字符串列表不匹配的任何行。到目前为止，这是我所拥有的，虽然可以正常运行，但速度却非常慢。有没有更快或更有效的方法来做到这一点？

Dim product As String
Dim TempArray as Variant
Dim idArray() As Variant
Dim myTable As ListObject


Sub rambler()

    Application.ScreenUpdating = False
    populatingArrays
    filterID
    Application.ScreenUpdating = True

End Sub


Sub populatingArrays()

    Sheets("Competitive Set").Activate
    Set myTable = ActiveSheet.ListObjects("Table1")
    TempArray = myTable.DataBodyRange.Columns(1)
    idArray = Application.Transpose(TempArray)

End Sub

Sub filterID()

    Sheets("Report").Activate
    ActiveSheet.Range("D2").Activate

        Do While ActiveCell.Value <> ""
          product = ActiveCell.Value
          IsInArray = UBound(Filter(idArray, product))

          If UBound(Filter(idArray, product)) < 0 Then
             ActiveCell.EntireRow.Delete
           Else
             Selection.Offset(1, 0).Select
          End If

        Loop

    ActiveSheet.Name = "I&D Data"
    ActiveSheet.Range("A1").Select

End Sub

注意：我知道我不应该使用“激活并选择”，但是我不确定在没有它们的情况下如何使这项工作有效。另一件事，此代码部分复制粘贴了，我不确定IsInArray是什么还是做什么，但是当我删除该行时，所有行都会被删除。

Answer 1

首先，我看不到使用全局变量的原因。让我们将它们的范围限制在其各自的子对象上。

第二，假设您的“报告”工作表中的数据位于D2:D100中，其中单元格D101是第一个空单元格。因此，您试图在范围D2到D100之间循环，并检查是否应用了过滤器。

第三，我将参数传递给sub，以使作用域尽可能保持局部。（我也在没有测试的情况下这样做，但是我认为它应该可以工作...）

如果是正确的话，我认为这应该为您更快地运行：

Option Explicit 'Forces you to declare all variables. This goes at the very top of the Module.
Sub rambler()
dim myArr as Variant
    Application.ScreenUpdating = False
    myArr = populatingArrays
    filterID(myArr)
    Application.ScreenUpdating = True
End Sub

Function populatingArrays() as Variant
Dim idArray() As Variant
Dim TempArray As Variant

    Set myTable = Sheets("Competitive Set").ListObjects("Table1")
    TempArray = myTable.DataBodyRange.Columns(1)
    idArray = Application.Transpose(TempArray)
    populatingArrays = idArray

End Sub

Sub filterID(arr as Variant)
Dim product As String
Dim myTable As ListObject
Dim lastRow As Long, i As Long

With Sheets("Report")
    lastRow = .Cells(Rows.Count, "D").End(xlUp).Row
    For i = lastRow To 1 Step -1 ' Deleting rows: it's best to start at the end and work up.
          product = .Cells(i, "D").Value
          IsInArray = UBound(Filter(arr, product))

          If IsInArray < 0 Then
             .Rows(i).EntireRow.Delete
          End If
    Next i
    .Name = "I&D Data"
End Sub

编辑：看看您是否能理解我如何删除.Select的用法。另外，要学习/理解的一件好事是如何将参数传递给子例程。我还将Sub populatingArrays()更改为Function，这使我们可以返回一些值（而对于Sub，要执行相同的操作，则需要一个Global变量）。使用 F8 单步执行此操作应该有助于了解其工作原理。

检查单元格内容是否包含列表中的字符串

1 个答案: