Question

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

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

Answer 1

在下面的代码中

简化OP代码
停止了ScreenUpdating和事件
在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

Answer 2

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

可能会加速很多。这可以防止屏幕更新，自动计算和事件在处理时触发。众所周知，这三种方法会降低性能。如果这不能令人满意地加速性能，你应该发布带有宏和测试数据的xml，这样我们就可以近距离观察。

Excel VBA：执行时间长

2 个答案: