Excel VBA：执行时间长

我创建了一个VBA代码，用于删除初始计算所需的额外行和列，但在将csv转换/导入数据库之前需要删除这些行和列。代码在21张纸上循环，运行约4分钟。这是一个合适的运行时间还是可以缩短？ ~z~谢谢

可能会加快很多。这可防止在处理过程中触发屏幕更新、自动计算和事件。众所周知，这三种方法会降低性能。如果这不能明显提高性能，您应该发布一个包含宏和测试数据的xml，这样我们可以仔细查看。

在下面的代码中

• 压缩操作码
• 已停止屏幕更新和事件
• 用自动筛选中的批量删除替换循环中的逐行删除

---

---

---

这个问题更适合一个想法（而且可能有点离题）。如果先禁用自动计算，速度会更快吗。。。。？或者，如果你使用类似“Sheets（“MyWorksheet”）.UsedRange.ClearContents”之类的东西…？我投票将这个问题作为主题外的问题来结束，因为它应该作为代码优化的代码审查站点来考虑。哇，这是一个未被充分认可的解决方案，+1。

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

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

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

  '... Your stuff

  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

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