VBA搜索值并从列表中删除（for循环太慢）

Posted 2021-04-01

我每周都会收到一份Excel文档，其中列出了尚未完成我们所获得的新IT系统培训的员工列表。但是，培训并不适合所有人，因此我需要进行清理以获得实际数字。

我列出了与（Oprydning）无关的培训员工，并使用以下代码一次搜索一个名称并从其他列表中删除（Datagrundlag）。

Private Sub RydOpKnap_Click()
Dim OprydningAntal As Long
Dim DataAntal As Long
Dim Find As String

Worksheets("Datagrundlag - endelig").Visible = True

OprydningsAntal = Worksheets("Oprydning").UsedRange.Rows.Count
DataAntal = Worksheets("Datagrundlag - endelig").UsedRange.Rows.Count

  Dim r, s As Long
    For r = 2 To OprydningsAntal
        Find = Worksheets("Oprydning").Cells(r, 1).Value
            For s = 2 To DataAntal


                If Worksheets("Datagrundlag - endelig").Cells(s, 3).Value = Find Then
                    Worksheets("Datagrundlag - endelig").Cells(s, 3).EntireRow.Delete
            Exit For
            End If
            Next s
    Next r

    Worksheets("Datagrundlag - endelig").Visible = False

    ActiveWorkbook.RefreshAll

End Sub

这需要永远，因为不相关的员工列表目前有460个不同的值（并且会变得更大）。还有另一种方法吗？我对VBA很新，但是可以使用数组吗？启动代码的“命令按钮”是否会变慢？

提前致谢！

海蒂

答案

从当前不相关的人员列表中创建一个数组，并将其用于使用xlFilterValues的AutoFilter。删除可见行并删除过滤器。

Option Explicit

Private Sub RydOpKnap_Click()
    Dim i As Long, j As Long

    ReDim notRelevant(0) As Variant

    With Worksheets("Oprydning")
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            ReDim Preserve notRelevant(i-2)
            notRelevant(i - 2) = .Cells(i, "A").Value
        Next i
    End With

    With Worksheets("Datagrundlag - endelig")
        .Visible = True

        If .AutoFilterMode Then .AutoFilterMode = False
        With .Range(.Cells(1, "C"), .Cells(.Rows.Count, "C").End(xlUp))
            .AutoFilter field:=1, Criteria1:=(notRelevant), Operator:=xlFilterValues
            .Offset(1, 0).EntireRow.Delete
        End With
        .AutoFilterMode = False

        .Visible = False
        .Parent.RefreshAll
    End With

End Sub

另一答案

还有另一种方法吗？

是的，使用条件格式为要排除的颜色eg着色，并过滤以删除带有格式化单元格的行。