For Loop的执行时间比询问的要长

时间:2018-01-17 17:47:41

标签: excel vba excel-vba

我在下面的代码中的for循环中遇到了问题。它应循环,直到达到(lastrow - 6)值。在我自己在调试模式下测试这段代码时,它每次都能正常工作并且正常退出,但是当最终用户使用时,for循环似乎比它退出循环之前运行的循环多1-3次。这会在查看数据时出现问题,因为日期与粘贴的数据不一致。

Sub ClearDPR()
    Dim lastrow As Long
    Dim Found As Range
    Dim copydate As Long
    Dim CopyShift As String
    Dim CopyCRO As String
    Dim BlankCells As Long
    Dim LastRowArchive As Long
    Dim Answer As Integer
    Dim r As Integer
    Dim i As Integer
    Dim startrow As Integer

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With


    ' PRINT REMINDER AND DPR CLEAR CONFIRMATION
    Answer = MsgBox("Have you printed the DPR?", vbYesNo, "Clear DPR")
    If Answer = vbNo Then
        Exit Sub
    Else                                         'COPY PASTE ACTIVITY SHEET ITEMS TO ARCHIVE
        'IF COLUMN O IS COMPLETE, THEN CHECKS PRIOR CELLS FILLED BEFORE CONSIDERING ROW & COLUMN AS TARGET CELL (ELSE MSGBOX)
        lastrow = wsActSht.Range("A7").End(xlDown).Row
        BlankCells = WorksheetFunction.CountBlank(wsActSht.Range("A7:R" & lastrow))

        If BlankCells <> 0 Then
            MsgBox ("Please fill the " & BlankCells & " blank cell(s) on DPR.")
            Exit Sub
        End If

        If BlankCells = 0 Then
            MsgBox "Entry accepted", vbInformation, "Accepted"

            If wsActSht.FilterMode = True Then
                wsActSht.ShowAllData
            End If


            'THEN COPY PASTE A:Q FROM ACTIVITY SHEET TO ARCHIVE STARTING WITH COLUMN D
            LastRowArchive = wsArch.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Row
            If SheetProtected(wsArch) Then
                wsArch.Unprotect "password"      'Unprotect Archive
            End If

            If wsArch.FilterMode = True Then
                wsArch.ShowAllData
            End If


            wsActSht.Range("A7:B" & lastrow).Copy Destination:=Sheets("Archive").Range("D" & LastRowArchive)
            wsActSht.Range("D7:R" & lastrow).Copy Destination:=Sheets("Archive").Range("F" & LastRowArchive)
            wsArch.Activate

            ' COPIES AND PASTES B5,D5,F5 FROM ACTIVITY SHEET TO SYNC WITH ROW PASTED ABOVE
            For r = 1 To lastrow - 6
                copydate = wsActSht.Range("B5").Value - 1
                CopyShift = wsActSht.Range("E5").Value & " &" & Chr(10) & wsActSht.Range("I5").Value
                CopyCRO = wsActSht.Range("G5").Value & " &" & Chr(10) & wsActSht.Range("K5").Value
                wsArch.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).NumberFormat = "m/d/yyyy" 'short date format of date before paste to archive
                wsArch.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = copydate
                wsArch.Range("A" & Rows.Count).End(xlUp).Offset(0, 20).Value = Format(Now(), "m/dd/yyyy h:mmAM/PM")
                wsArch.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = CopyShift
                wsArch.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = CopyCRO
                wsArch.Range("C" & Rows.Count).End(xlUp).EntireRow.AutoFit 'size row to show all contents of COLUMN C
            Next r

            wsArch.Protect "password", , , , , , , , , , , , , True, True 'Protect Archive

            'REFRESH DPR FOR NEXT 24 HOUR USE
            wsActSht.Activate
            Range("I7:J" & lastrow).Select
            Selection.ClearContents              'CLEAR DAY AND NIGHT OPERATORS
            Range("N7:O" & lastrow).Select
            Selection.ClearContents              'CLEAR LBS RAN SPACE FOR BOTH SHIFTS

            startrow = 7
            For i = startrow To lastrow          'INDEXES ROWS AND REMOVE ROWS MARKED YES IN COLUMN Q (ROWS WHICH HAVE BEEN INDICATED THAT THE LOT IS COMPLETE)
                If Range("R" & i).Value = "YES" Or Range("R" & i).Value = "Yes" Or Range("R" & i).Value = "yes" Then
                    Range("R" & i).Select
                    Selection.EntireRow.Delete
                    i = i - 1
                End If
            Next i

            'CLEAR SHIFT AND CRO FOR DAYS AND NIGHTS

            With wsActSht
                .Range("E5").Value = "Click Here"
                .Range("I5").Value = "Click Here"
                .Range("G5").Value = ""
                .Range("K5").Value = ""
            End With

            MsgBox ("DPR Cleared to completion")

            'SAVE DOCUMENT
            LotFolder.Save

        End If
    End If

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With

End Sub

2 个答案:

答案 0 :(得分:1)

在某些方面,您需要检查代码。

首先,wsActSht未在子例程范围内定义。如果wsActSheetPublic(也称为Global)变量,那么这就是代码气味。此外,该名称看起来非常像ActiveSheet。这不是CodeReview,所以我会放弃咆哮,但简而言之,就是使用描述性名称。

接下来,我不太确定这是你要找的那条线:

lastrow = wsActSht.Range("A7").End(xlDown).Row

这将在您的行中找到第一个中断,而不是包含数据的最后一行。通常,模式是:

lastrow = wsActSht.Range("A7").End(xlUp).Row

接下来,您有几个这种模式的实例:

LastRowArchive = wsArch.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Row

请注意,Rows.Count表示ActiveSheet.Rows.CountwsActSht.Rows.Count不同(请参阅如何在屁股上咬你?)。您的wsActSht保留Worksheet Active Set时的ActiveSheet,而不是当前... Destination:=Sheets("Archive").Range("D" & LastRowArchive)

沿着这些方向,也要注意这一点:

Sheets

同样,ActiveWorkbook.Sheets在这里指的是ThisWorkbook.Sheets而不是Subscript Out of Range。你一定会在这里遇到wsActSht.Activate Range("I7:J" & lastrow).Select Selection.ClearContents 'CLEAR DAY AND NIGHT OPERATORS Range("N7:O" & lastrow).Select Selection.ClearContents 错误。

这是另一个:

Activate

如果DPR语句与其余语句之间的另一个工作表变为活动状态,请猜测会发生什么?突然之间,您现在可能会删除该表上的所有数据,并且无法将其恢复。

那么,你如何解决所有这些问题?

首先,确保一切合格。使用描述性名称创建变量,例如SheetToClearWorkbook,以便您知道自己在做什么,以及何时进行处理。这包括ThisWorkbook个变量。我更喜欢Workbook,但这假设您的代码正在运行它的Rows.Count Range("A1").Value Sheets("SuperImportantData") 。如果不是这种情况,您可以为此目的创建变量。

一旦你完成了这项工作,你需要训练自己在较低的水平上寻找没有任何东西的东西。所以:

SomeImportantSheet.Rows.Count
SomeImportantSheet.Range("A1").Value
SomeImportantWorkbook.Sheets("SomeImportantData")

所有变成代码的味道都是因为它们应该是:

.Activate

通过强制执行此练习,您将免除许多麻烦。

最后,不要使用Activate 。不,不管是,还是关于它。除非您确实使用Activate将视图返回到用户启动的位置,否则没有充分的理由使用read': No such file or directory @ rb_sysopen - /home/darren/.ssh/id_rsa.pub。改为使用变量。

祝你好运。

答案 1 :(得分:0)

设置Product.colored_product("red" or "blue)时,值可能会因该列中的数据而异。

例如,如果有来自A8-A10的条目,则lastrow将为10.如果A9为空白,则lastrow为8。

请告诉我这是否有帮助!