协助循环效率

Question

首先让我说谢谢你的帮助，因为我对 VBA 还比较陌生。

目前我有一个 loop 贯穿 5 columns 以清除任何在 Column A 中没有价值的 rows 然后它贯穿其他 4 columns 以匹配同一 workbook 中另一个 sheet 的数据。我已经研究了多种方法来更有效地做到这一点，但没有运气。下面是我目前正在使用的loop。我想要一些想法，以便代码更有效地运行。

Dim wsDE As Worksheet
Dim wsMasterList As Worksheet
Dim City As Range
Dim State As Range
Dim AgeL As Range
Dim AgeU As Range
Dim Gender As Range
Dim x As Long
Dim lastx As Long

Set wsDE = ThisWorkbook.Sheets("DataEntry")
Set wsMasterList = ThisWorkbook.Sheets("MasterList")
Set City = wsDE.Range("B1")
Set State = wsDE.Range("C1")
Set AgeL = wsDE.Range("D1")
Set AgeU = wsDE.Range("E1")
Set Gender = wsDE.Range("F1")

lastx = wsMasterList.Range("A" & wsMasterList.Rows.Count).End(xlUp).Row
wsMasterList.Range("A1").Select

For x = 2 To lastx
    If wsMasterList.Range("A" & x) = vbNullString Then
        wsMasterList.Range("A" & x).EntireRow.Delete
        GoTo NX
    End If
    If City <> "N/A" Then
        If wsMasterList.Range("I" & x).Value <> UCase(City) Then
            wsMasterList.Range("I" & x).EntireRow.Delete
            GoTo NX
        End If
    End If
    If State <> "N/A" Then
        If wsMasterList.Range("J" & x).Value <> UCase(State) Then
            wsMasterList.Range("J" & x).EntireRow.Delete
            GoTo NX
        End If
    End If
    If AgeL <> "N/A" Then
        If wsMasterList.Range("E" & x) < AgeL Then
            wsMasterList.Range("E" & x).EntireRow.Delete
            GoTo NX
        End If
    End If
    If AgeU <> "N/A" Then
        If wsMasterList.Range("E" & x) > AgeU Then
            wsMasterList.Range("E" & x).EntireRow.Delete
            GoTo NX
        End If
    End If
    If Gender = "Male" Then
        If wsMasterList.Range("D" & x) <> "M" Then
            wsMasterList.Range("D" & x).EntireRow.Delete
            GoTo NX
        End If
    End If
    If Gender = "Female" Then
        If wsMasterList.Range("D" & x) <> "F" Then
            wsMasterList.Range("D" & x).EntireRow.Delete
            GoTo NX
        End If
    End If

NX:
Next x

Answer 1

我唯一的建议是订购您的支票，以确保它们是按最常见的删除行的情况订购的。这减少了必须检查的 "If" 语句的数量。因此，如果 AgeL 通常删除最多的记录，这应该是您的第一次检查，然后是下一个最常见的成功检查，依此类推。这样您就可以减少必须执行的检查次数。这不是一个巨大的收获，但它会帮助一些人。

Answer 2

我不知道这是否更好：交易 space 复杂性...

它确实展示了如何构建单个删除范围。

Sub Tester()
    Dim wsDE As Worksheet
    Dim wsMasterList As Worksheet
    Dim City As Range
    Dim State As Range
    Dim AgeL As Range
    Dim AgeU As Range
    Dim Gender As Range
    Dim x As Long
    Dim lastx As Long, rngDel As Range, rw As Range

    Set wsDE = ThisWorkbook.Sheets("DataEntry")
    Set wsMasterList = ThisWorkbook.Sheets("MasterList")
    Set City = wsDE.Range("B1")
    Set State = wsDE.Range("C1")
    Set AgeL = wsDE.Range("D1")
    Set AgeU = wsDE.Range("E1")
    Set Gender = wsDE.Range("F1")

    lastx = wsMasterList.Range("A" & wsMasterList.Rows.Count).End(xlUp).Row

    For x = 2 To lastx

        Set rw = wsMasterList.Rows(x)
        'Only really one criteria for this check, so just pass True for crit1 ...
        '   If CheckIt returns True, then we've already flagged this row for deletion 
        '   and the other checks can be skipped
        If CheckIt(rngDel, rw, True, rw.Cells(1, "A") = vbNullString) Then GoTo NX
        If CheckIt(rngDel, rw, City <> "N/A", rw.Cells(1, "I") <> UCase(City)) Then GoTo NX
        If CheckIt(rngDel, rw, State <> "N/A", rw.Cells(1, "J") <> UCase(State)) Then GoTo NX
        If CheckIt(rngDel, rw, AgeL <> "N/A", rw.Cells(1, "E") < AgeL) Then GoTo NX
        If CheckIt(rngDel, rw, AgeU <> "N/A", rw.Cells(1, "E") > AgeU) Then GoTo NX
        If CheckIt(rngDel, rw, Gender = "Male", rw.Cells(1, "D") <> "M") Then GoTo NX
        If CheckIt(rngDel, rw, Gender = "Female", rw.Cells(1, "D") <> "F") Then GoTo NX
NX:
    Next x
    If Not rngDel Is Nothing Then rngDel.Delete
End Sub


'Function to check two criteria to see if a row should be deleted or not
'  returns true if the row is to be deleted.

'rngDelete: the range we're building for eventual deletion
'rw:        the current row being checked
'crit1:     first check (something that evaluates to True or False)
'crit2:     second check (something that evaluates to True or False)
Function CheckIt(ByRef rngDelete As Range, rw As Range, crit1 As Boolean, crit2 As Boolean) As Boolean
    CheckIt = False       '<< by default returns false
    If crit1 Then         '<< check the first and second criteria 
        If crit2 Then
            'both criteria passed, so collect the row for later deletion 
            If rngDelete Is Nothing Then
                'if "rngDelete" has no rows then use the passed row
                Set rngDelete = rw 
            Else
                'add the passed row to the range to be deleted
                Set rngDelete = Application.Union(rng, rw)
            End If
            CheckIt = True '<< return True so we can skip any other checks for deletion
        End If
    End If
End Function

协助循环效率

Assistance with loop efficiency

excel

vba

excel-2013