Удаление временных рядов и столбцов из 21 лист из книги


Я создал код 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


177
3
задан 6 апреля 2018 в 06:04 Источник Поделиться
Комментарии
2 ответа

Портланд Бегун дал некоторые хорошие советы в комментариях. Выбор и просмотр изменений не добавить любое значение, что вы хотите достичь. Мне удалось снять их без проблем. При выполнении макроса на основе манипуляций в Excel, вы всегда должны учитывать:


  • Установка Application.ScreenUpdating для False

  • Установка Application.Calculation для xlManual

  • Установка Application.EnableEvents для False

  • Сбросив все эти значения, когда вы завершили работу

Конечно, будут исключения, но они должны быть редкими.

Всегда помните, Option Explicit в VBA

Глядя на абсолютные значения:

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

Это может быть просто:

For Each xWs In Application.ActiveWorkbook.Worksheets
xWs.UsedRange.Value = xWs.UsedRange.Value
Next

Чище, проще, чтобы посмотреть, что он делает, и проще в обслуживании.

Глядя на столбец B условия:

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

Может стать:

For Each xWs In Application.ActiveWorkbook.Worksheets
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

Но я вижу повторение здесь. Вы можете спасти себя небольшую петлю. Следует признать, что в пример вы привели не большая проблема, но все-таки лучше иметь.

Совмещая петли - обратите внимание на порядок, в котором я сделал это. Сделать большинство работы первого, а затем сделать простой очистки. Вы могли бы сделать это другим путем (за исключением xlError преобразуется в значение по пути?) но учитывая, сколько работы делается в каждом шаге и как каждый шаг влияет на размер будущей работы-это хорошая привычка.

For Each xWs In Application.ActiveWorkbook.Worksheets
Firstrow = xWs.UsedRange.Cells(1).Row
Lastrow = xWs.UsedRange.Rows(xWs.UsedRange.Rows.count).Row ' this is yet another different way I have seen to get the last row!
For Lrow = Lastrow To Firstrow Step -1 ' Good that you know to go backwards.
With xWs.Cells(Lrow, "B")
If Not IsError(.Value) Then
If .Value = "0" Then .EntireRow.Delete
End If
End With
Next Lrow
xWs.UsedRange.Value = xWs.UsedRange.Value ' Good that you know the simple way to convert formulas to values.
Next

Удаление дополнительных столбцов - я вижу много повторов здесь и место для подпрограммы.

Private Sub Delete78(xWs as Worksheet) 'Sheet could also include a Chart sheet
xWS.Columns(8).EntireColumn.Delete
xWS.Columns(7).EntireColumn.Delete
End Sub

Интересно, что вы могли бы сделать Col7.Del, а затем Col7.Del, чтобы достичь того же эффекта! Но хотя бы так, как вы написали, это показывает намерение снять две колонны.

Вы основную часть код становится:

Delete78 Sheets("IP-FSW")
Delete78 Sheets("IP-2070")
Delete78 Sheets("IP-MNTR")
Delete78 Sheets("IP-BBS")
Delete78 Sheets("IP-DET")
Delete78 Sheets("IP-TTR")
Delete78 Sheets("IP-CCTV")

Еще несколько повторений - и это может быть исправлено так же. Но это может быть еще один день. Или, возможно, сейчас. Поскольку последний блок кода выглядит иначе, но это действительно то же самое. Так давайте попробуем новую подпрограмму.

Private Sub DeleteColumnBlock(xWs as Worksheet, LastColumn as Long, FirstColumn as Long) ' Get the user to enter the values in a logical order. I chose this way.
Dim ColIterator as Long
' Do some input validation. If they have entered bad values, fix it.
For ColIterator = LastColumn to FirstColumn Step -1
xWs.Columns(ColIterator).EntireColumn.Delete
Next ColIterator
End Sub

Потому что мы имеем дело с последовательными блоками, вы можете сделать это немного более неясными - же эффект, но немного сложнее, чтобы сразу увидеть, что вы намерены делать. Добавить некоторые хорошие комментарии, если вы намерены сделать это!

For ColIterator = FirstColumn to LastColumn
xWs.Columns(FirstColumn).EntireColumn.Delete ' continually remove a column until the right number have been removed.
Next ColIterator

Ваша главная часть этого весь блок тогда становится:

DeleteColumnBlock Sheets("IP-FSW"), 8, 7
DeleteColumnBlock Sheets("IP-2070"), 8, 7
DeleteColumnBlock Sheets("IP-MNTR"), 8, 7
DeleteColumnBlock Sheets("IP-BBS"), 8, 7
DeleteColumnBlock Sheets("IP-DET"), 8, 7
DeleteColumnBlock Sheets("IP-TTR"), 8, 7
DeleteColumnBlock Sheets("IP-CCTV"), 8, 7
DeleteColumnBlock Sheets("IP-Unassigned"), 16, 8

Резюме


  • Выключите части Excel, которая вам не нужна, когда делаешь хрюкать
    работы.

  • Попробуйте запустить через петлю только один раз, не повторяйте петли
    если это действительно необходимо.

  • Dry (не повторяй себя) - повторение является признаком того, что вы можете
    modularise какой-то код, что делает его легче поддерживать.

  • Использовать явные решения, избежать Active и Select если нет
    нет другого способа (например, копирование листов в новую книгу-это подпрограмма,
    не так ActiveWorkbook это единственный способ немедленно
    ссылка, что новую книгу).

  • - Если вы делаете Activate или Selectубедитесь, что следующий код на самом деле использует эти элементы.

  • - И затем рассмотреть, если вы уже можете ссылаться на него явно и не так!

Добавление

В моих примерах выше, я предоставил очень механистический способ удаления столбцов (на основе ОП код). Еще два способа сделать это без использования цикла для задания диапазона:


  • например xWS.Range(xWS.Cells(1,7), xWS.Cells(1,8).EntireColumn.Delete

  • Установив Союз столбцов, а затем удаление

4
ответ дан 6 апреля 2018 в 09:04 Источник Поделиться

В коде ниже


  • Сокращенная ОП код

  • Остановился свойство screenupdating и событий

  • Заменить построчное удаление в циклах с массового удаления в автофильтров


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


2
ответ дан 6 апреля 2018 в 09:04 Источник Поделиться