Excel VBA:执行时间长 [英] Excel VBA: Long Execution Time

问题描述

我创建了一个VBA代码，以删除初始计算所需的多余行和列，但在将csv转换/导入到数据库中之前必须将其删除.该代码循环遍历21张纸，并运行约4分钟.这是一个体面的运行时间还是可以缩短?〜谢谢

I've created a VBA code to delete extra rows and columns that were needed for initial calculations but are required to be removed before converting/importing a csv into a database. The code loops through 21 sheets and runs for about 4 minutes. Is this a decent run time or can it be shortened? ~Thanks

Public Sub Test()

Dim xWs As Worksheet
Set xWs = ActiveSheet
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

'SETTING DEPENDENT VALUES TO ABSOLUTE VALUES============================='

For Each xWs In Application.ActiveWorkbook.Worksheets
    xWs.Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    xWs.DisplayPageBreaks = False
    xWs.UsedRange.Value = xWs.UsedRange.Value
Next

'DELETING ROWS BASED ON COLUMN B VALUES=================================='

For Each xWs In Application.ActiveWorkbook.Worksheets
    xWs.Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    xWs.DisplayPageBreaks = False
    Firstrow = xWs.UsedRange.Cells(1).Row
    Lastrow = xWs.UsedRange.Rows(xWs.UsedRange.Rows.count).Row
    For Lrow = Lastrow To Firstrow Step -1
        With xWs.Cells(Lrow, "B")
            If Not IsError(.Value) Then
                If .Value = "0" Then .EntireRow.Delete
            End If
        End With
    Next Lrow
Next

'DELETING DUPLICATE IP ADDRESSES=========================================='

With Sheets("IP-Unassigned")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Firstrow = .UsedRange.Cells(1).Row
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.count).Row
    For Lrow = Lastrow To Firstrow Step -1
        With .Cells(Lrow, "H")
            If Not IsError(.Value) Then
                If .Value = "1" Then .EntireRow.Delete
            End If
        End With
    Next Lrow
End With

'DELETING EXTRA COLUMNS========================================================'

With Sheets("IP-FSW")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-2070")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-MNTR")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-BBS")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-DET")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-TTR")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-CCTV")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-Unassigned")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(16).EntireColumn.Delete
    Columns(15).EntireColumn.Delete
    Columns(14).EntireColumn.Delete
    Columns(13).EntireColumn.Delete
    Columns(12).EntireColumn.Delete
    Columns(11).EntireColumn.Delete
    Columns(10).EntireColumn.Delete
    Columns(9).EntireColumn.Delete
    Columns(8).EntireColumn.Delete
End With

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

End Sub

推荐答案

在下面的代码中

• 浓缩了操作码
• 停止屏幕更新和事件
• 在循环中逐行删除，并在AutoFilters中批量删除

Option Explicit

Public Sub RemoveTmpData()
    Const WS_2COLS = "|IP-FSW|IP-2070|IP-MNTR|IP-BBS|IP-DET|IP-TTR|IP-CCTV|"
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Application.EnableEvents = False
        For Each ws In ThisWorkbook.Worksheets
            ws.DisplayPageBreaks = False
            ws.UsedRange.Value2 = ws.UsedRange.Value2   'convert formulas to values
            If InStr(WS_2COLS, "|" & ws.Name & "|") > 0 Then ws.Columns("G:H").Delete
            RemoveTmpRows ws.UsedRange, 2, 0            'remove rows with val 0, in col B
        Next

        With ThisWorkbook.Worksheets("IP-Unassigned")
            RemoveTmpRows .UsedRange, 8, 1              'remove rows with val 1, in col H
            .UsedRange.Columns("H:P").Delete
        End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Private Sub RemoveTmpRows(ByRef rng As Range, ByVal colId As Long, ByVal crit As String)
    With rng
        .AutoFilter Field:=colId, Criteria1:=crit
        If .Columns(colId).SpecialCells(xlCellTypeVisible).CountLarge > 1 Then
            .Rows(1).Hidden = True
            .SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .Rows(1).Hidden = False
        End If
        .AutoFilter
    End With
End Sub

这篇关于Excel VBA:执行时间长的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！