VBA:Excel宏在调试中正确执行,但在执行时不运行sub

时间:2018-09-12 23:47:54

标签: excel vba excel-vba

我的代码是引用一个命名范围(泵号),在表(另一个工作表)中查找最后一个实例,复制在其中找到的行,并将该数据粘贴到在表中创建的新行中。然后循环遍历另一张纸上的一系列单元并找到真实值。如果值为true,则将复制另一个命名的range(Hours),并将该值粘贴到正确列的表中。该代码在调试中正确执行,一次只执行一行,但是在正常运行时,它不会复制表中的最后一行数据并将值粘贴到新行中。无法正常运行的代码从第90行开始

Sub SavePumpMaintenance()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Dim tbla As ListObject, last_row, total_stage As Integer
    Dim issue, pump, pump_hrs, main_date, main_code As String
    Dim correct_plunger, correct_part As Boolean, Data As Worksheet
    Dim Maint As Worksheet, wSheet As Worksheet, r As Long
    Dim tbl As ListObject, newrow As ListRow, i As Long
    Dim cells As Range, LR As Integer, Hist As Worksheet

    Set Hist = Sheet26
    Set CurrentHours = Range("CurrentHours")
    Set tbl = Hist.ListObjects("Historical")
    Set newrow = tbl.ListRows.Add
    Set Data = Sheet5
    Set Maint = Sheet3
    Set tbla = Maint.ListObjects("MaintPerformed")
    correct_plunger = Data.Range("N6").Value
    correct_part = Data.Range("N10").Value
    main_code = Data.Range("Y8").Value
    issue = Data.Range("Y11").Value
    last_row = Data.Range("N11").Value
    pump = Maint.Range("C6").Value
    pump_hrs = Maint.Range("C7").Value
    main_date = Maint.Range("C8").Value
    total_stage = Maint.Range("C9").Value
    LR = tbl.Range(Rows.Count).End(xlUp).Row

    'Unprotect all sheets
    For Each wSheet In Worksheets
        wSheet.Unprotect Password:="SomePassword"
    Next wSheet
    If pump = "" Then
        MsgBox "Please select a pump."
        Application.Calculation = xlCalculationAutomatic
        Exit Sub
    End If
    If pump_hrs = "" Then
        MsgBox "Please enter hours."
        Application.Calculation = xlCalculationAutomatic
        Exit Sub
    End If
    If Range("Date") = "" Then
        MsgBox "Please enter date and time of maintenance."
        Application.Calculation = xlCalculationAutomatic
        Exit Sub
    End If
    If correct_plunger = False Then
        MsgBox "Incorrect plunger type selected"
        Application.Calculation = xlCalculationAutomatic
        Exit Sub
    End If
    If correct_part = False Then
        MsgBox "Incorrect part type selected"
        Application.Calculation = xlCalculationAutomatic
        Exit Sub
    End If
    Data.Range("T3:T37").Copy 'Copy used parts/pump info to maintenance table
    Maint.Range("O1").Offset(last_row,0).PasteSpecial xlValues,Transpose:=True
    Data.Range("U3:U12").Copy
    Maint.Range("BJ1").Offset(last_row,0).PasteSpecial xlValues,Transpose:=True
    Maint.Range("J1").Offset(last_row, 0).Value = pump
    Maint.Range("J1").Offset(last_row, 1).Value = pump_hrs
    Maint.Range("J1").Offset(last_row, 2).Value = total_stage
    Maint.Range("J1").Offset(last_row, 3).Value = main_date
    Maint.Range("J1").Offset(last_row, 4).Value = main_code
    Maint.Range("J1").Offset(last_row, 63).Value = issue

    'Copy last set of historical data for pump 'add maintenance to history
    For r = 1 To LR Step 1
        If tbl.Range(r, 1).Value = Range("Pumpnumber") Then
            Range("H" & r & ":V" & r).Copy
            newrow.Range(8).PasteSpecial Paste:=xlValues
        End If
    Next r
    With newrow 'Paste current pump information
        .Range(1) = Range("Pumpnumber")
        .Range(2) = Range("Date")
        .Range(3) = CurrentHours
        .Range(4) = Range("Position")
        .Range(5) = Range("Fleet")
        .Range(6) = Range("WFNumb")
        .Range(7) = Range("OStage")
    End With

    'copy hours from maintenance if checked into maint. history
    For i = 1 To 5
        If Maint.cells(13, i + 2).Value = True Then
            CurrentHours.Copy
            newrow.Range(7 + i).PasteSpecial xlPasteValues
        End If
        If Maint.cells(16, i + 2).Value = True Then
            CurrentHours.Copy
            newrow.Range(12 + i).PasteSpecial xlPasteValues
        End If
        If Maint.cells(21, i + 2).Value = True Then
            CurrentHours.Copy
            newrow.Range(17 + i).PasteSpecial xlPasteValues
        End If
        If Maint.cells(22, i + 2).Value = True Then
            CurrentHours.Copy
            newrow.Range(17 + i).PasteSpecial xlPasteValues
        End If
    Next i
    Application.CutCopyMode = False

    Dim mp As Range, P As Range 'Copy Current hrs to Equipment Sheet
    Set mp = Range("MyPumps")
    For Each P In mp
        If P.Value = Range("PumpNumber") Then
            P.Offset(0, 5).Value = Range("CurrentHours")
        End If
    Next P

    Sheet3.Protect Password:="MyPassword"  'Protect sheets
    Sheet5.Protect Password:="MyPassword"
    Sheet16.Protect Password:="MyPassword"
    Sheet25.Protect Password:="MyPassword"
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

0 个答案:

没有答案