协助提高循环效率

时间:2018-08-23 14:43:43

标签: excel vba excel-vba excel-2013

首先,我要感谢您的帮助,因为我对VBA还是比较陌生。

目前,我有一个loop,它遍历5 columns,以清除rows中没有任何值的Column A,然后遍历其他4 {{ 1}},以匹配同一columns中另一个sheet上的数据。我已经尝试了多种方法来更有效地执行此操作,但是没有运气。以下是我目前正在使用的workbook。我想要一些想法,以便代码更有效地运行。

loop

2 个答案:

答案 0 :(得分:1)

我唯一的建议是对支票进行排序,以确保它们按删除行的最常见情况进行排序。这减少了必须检查的“ If”语句的数量。因此,如果AgeL通常删除最多的记录,那应该是您的第一个检查,然后是下一个最常见的成功检查,以此类推。这样可以减少必须执行的检查次数。这不是一个巨大的收益,但是会有所帮助。

答案 1 :(得分:0)

我不知道这是否更好:用空间换取复杂性...

它确实显示了如何为删除建立单个范围。

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