过滤掉多个项目

时间:2018-03-14 15:49:44

标签: vba excel-vba excel

我正在尝试从列表中过滤掉大量项目。我有大约500个键来过滤700个输入列表。我不知道每个键是否有一个列表项,所以我说的“哑”方法是循环每个键,将它与每行进行比较输入列表。我编写的代码在技术上有效,但是当我尝试使用太多密钥进行测试时,它的效率并不高。有更优雅的解决方案吗?

我的尝试:

Sub ExcludeKeys()

'Copy input to new output sheet
Dim outputTabName As String
Worksheets("Input").Copy After:=Worksheets(Worksheets.Count)
outputTabName = "Output " + Strings.Trim(Worksheets.Count - 3)
Worksheets(Worksheets.Count).Name = outputTabName

'Get the column letter the keys are in (input data)
Dim keyCol As String
keyCol = Strings.Trim(Worksheets("Home").Range("D17").Value)

Dim row As Range
Dim totalRows As Long
Dim keyToEval As Variant

'Make an array out of existing keys
totalKeys = Worksheets("Keys").Rows.End(xlUp).row

'Go through the Output sheet
For rowNum = 2 To Worksheets(outputTabName).Rows.Count

    'Go through all keys to exclude
    For i = 1 To LastRow(Worksheets("Keys").Name, 1)

        'Get new key to compare to (in output)
        keyToEval = Strings.Trim(Worksheets(outputTabName).Range(keyCol & rowNum).Value)

        'If keys match, delete
        If keyToEval = Strings.Trim(Worksheets("Keys").Range("A" & i).Value) Then
            Worksheets(outputTabName).Range(keyCol & rowNum).Rows.EntireRow.Delete
            'If a row was deleted, go back 1 (avoids skipping next)
            i = 1
        End If
    Next i
Next rowNum

End Sub

'----------
' Handy function to find the last row of a column
' Source: https://stackoverflow.com/a/48504852/4984516
Function LastRow(Optional strSheet As String, Optional columnToCheck As Long = 1) As Long

    Dim shSheet As Worksheet

    If strSheet = vbNullString Then
       Set shSheet = ActiveSheet
    Else
        Set shSheet = Worksheets(strSheet)
    End If

    LastRow = shSheet.Cells(shSheet.Rows.Count, columnToCheck).End(xlUp).row

End Function

2 个答案:

答案 0 :(得分:0)

如果它们是相同的类型(整数,字符串),那么我会将两个列表放入List(of)中,然后使用Except函数。这将返回原始列表中不存在的所有项目的列表。这不会修改任何一个列表。

var remainingItems = FullList.Except(excludeList);

答案 1 :(得分:0)

感谢您的建议,但我想出了一个更好的方法。这实际上是高级过滤器按钮的宏版本。我将“输入”选项卡复制到“输出”,然后按照以下方式处理:

Dim keyCount As Long
keyCount = Sheets("Keys").Cells(Sheets("Keys").Rows.Count, "A").End(xlUp).row

Worksheets("Output").Range("A2").Select
Range(Selection, Selection.End(xlDown)).AdvancedFilter Action:=_
    xlFilterInPlace, CriteriaRange:=_
    Sheets("Keys").Range("A1:A" & keyCount), Unique:=False

无需循环,速度非常快。