如何优化此代码的时间执行

时间:2019-07-01 18:17:52

标签: excel vba

我在公司中有此报告,并且将数据写到表中的时间太长了。

我试图在工作表或表格的名称中不要使用变量“ main”,但是时间是相同的。

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

main = Range("Line").Value

Set ws = Sheets("Database " & main)
Set wh = Sheets("Downtimes " & main)
Set wl = Sheets("Losses " & main)
Set wa = Sheets("PlannedStops " & main)

Set ts = ws.ListObjects("Database_" & main)
Set th = wh.ListObjects("Downtimes_" & main)
Set tl = wl.ListObjects("Losses_" & main)
Set ta = wa.ListObjects("PlannedStops_" & main)

ws.Visible = True
wh.Visible = True
wl.Visible = True
wa.Visible = True

If ts.ShowAutoFilter Then

    ts.AutoFilter.ShowAllData

End If

'======================================================================================

If (wp.Range("PLOT")) = 0 Then

    With wa

        For i = 1 To wp.ListObjects("PLST").DataBodyRange.Rows.Count

            If IsEmpty(wp.ListObjects("PLST").DataBodyRange(i, 1)) Then
                Exit For
            Else
                Set newrow = ta.ListRows.Add
                With newrow
                    .Range(1).Value = wp.Range("Date")
                    .Range(5).Value = wp.Range("Shift")
                    .Range(6).Value = wp.Range("ShiftLeader")
                    .Range(7).Value = wp.Range("Color")
                    .Range(8).Value = wp.ListObjects("PLST").DataBodyRange(i, 1).Value
                    .Range(9).Value = wp.ListObjects("PLST").DataBodyRange(i, 2).Value
                End With
                Set newrow = Nothing
            End If

        Next i

    End With

Else

    With ws
        Set newrow = ts.ListRows.Add
        With newrow
            .Range(1).Value = wp.Range("Date")
            .Range(5).Value = wp.Range("Shift")
            .Range(6).Value = wp.Range("ShiftLeader")
            .Range(7).Value = wp.Range("Color")
            .Range(8).Value = wp.Range("PLOT")
            .Range(9).Value = wp.Range("OPT")
            .Range(10).Value = wp.Range("PRDT")
            .Range(11).Value = wp.Range("PFMT")
            .Range(12).Value = wp.Range("EFT")
            .Range(13).Value = wp.Range("PLTM")
        End With
        Set newrow = Nothing
    End With

    With wh

        For i = 1 To wp.ListObjects("DWNT").DataBodyRange.Rows.Count

            If IsEmpty(wp.ListObjects("DWNT").DataBodyRange(i, 1)) Then
                Exit For
            Else
                Set newrow = th.ListRows.Add
                With newrow
                    .Range(1).Value = wp.Range("Date")
                    .Range(5).Value = wp.Range("Shift")
                    .Range(6).Value = wp.Range("ShiftLeader")
                    .Range(7).Value = wp.Range("Color")
                    .Range(8).Value = wp.ListObjects("DWNT").DataBodyRange(i, 1).Value
                    .Range(9).Value = wp.ListObjects("DWNT").DataBodyRange(i, 2).Value
                End With
                Set newrow = Nothing
            End If

        Next i

    End With

    With wl

        For i = 1 To wp.ListObjects("PFLS").DataBodyRange.Rows.Count

            If IsEmpty(wp.ListObjects("PFLS").DataBodyRange(i, 1)) Then
                Exit For
            Else
                Set newrow = tl.ListRows.Add
                With newrow
                    .Range(1).Value = wp.Range("Date")
                    .Range(5).Value = wp.Range("Shift")
                    .Range(6).Value = wp.Range("ShiftLeader")
                    .Range(7).Value = wp.Range("Color")
                    .Range(8).Value = wp.ListObjects("PFLS").DataBodyRange(i, 1).Value
                    .Range(9).Value = wp.ListObjects("PFLS").DataBodyRange(i, 4).Value
                    .Range(10).Value = wp.ListObjects("PFLS").DataBodyRange(i, 3).Value
                End With
                Set newrow = Nothing
            End If

        Next i

        If wp.Range("UNLS") = 0 Then
        Else
            Set newrow = tl.ListRows.Add
            With newrow
                .Range(1).Value = wp.Range("Date")
                .Range(5).Value = wp.Range("Shift")
                .Range(6).Value = wp.Range("ShiftLeader")
                .Range(7).Value = wp.Range("Color")
                .Range(8).Value = "Null"
                .Range(9).Value = wp.Range("UNLS")
                .Range(10).Value = "Pérdidas no identificadas"
            End With
            Set newrow = Nothing
        End If

    End With

    With wa

        For i = 1 To wp.ListObjects("PLST").DataBodyRange.Rows.Count

            If IsEmpty(wp.ListObjects("PLST").DataBodyRange(i, 1)) Then
                Exit For
            Else
                Set newrow = ta.ListRows.Add
                With newrow
                    .Range(1).Value = wp.Range("Date")
                    .Range(5).Value = wp.Range("Shift")
                    .Range(6).Value = wp.Range("ShiftLeader")
                    .Range(7).Value = wp.Range("Color")
                    .Range(8).Value = wp.ListObjects("PLST").DataBodyRange(i, 1).Value
                    .Range(9).Value = wp.ListObjects("PLST").DataBodyRange(i, 2).Value
                End With
                Set newrow = Nothing
            End If

        Next i

    End With

End If

ws.Visible = False
wh.Visible = False
wl.Visible = False
wa.Visible = False

Application.ScreenUpdating = True

End Sub

我没有错误,我的代码可以正常工作,同一张纸上有更多代码,但是我认为这部分是代码中最耗时的,任何人都可以提出建议以使其更快?

0 个答案:

没有答案