Как написать код VBA для удаления определенных столбцов для всех листов в книге? - PullRequest
0 голосов
/ 08 мая 2018

Я использую Excel 2016 и я новичок в VBA. Мне нужно написать код VBA для удаления определенных столбцов для всех листов в книге Excel.

Предположим, что столбцы, которые мне нужно удалить, это столбцы B, D, G, H, AM, AZ для всех листов.

Как мне этого добиться?

Ответы [ 4 ]

0 голосов
/ 09 мая 2018

Сравнительная производительность:

All-at-once - Total Sheets: 1,001 - Time: 29.137 sec (by JvdV)
One-by-one  - Total Sheets: 1,001 - Time: 72.164 sec

Вот тесты


Option Explicit

Public Sub DeleteColumns()
    Dim thisWs As Worksheet, thisCell As Range, t As Double, msg As String

    t = Timer
    Application.ScreenUpdating = False
    Set thisWs = ActiveSheet
    Set thisCell = ActiveCell

        ThisWorkbook.Worksheets.Select      'Selects all sheets at once

        Range("B1, D1, G1:H1, AM1, AZ1").EntireColumn.Select  'All columns on all sheets

        Selection.Delete Shift:=xlToLeft    'Deletes all columns on all sheets at once

    Cells(1).Select     'Selects A1 on all sheets
    thisWs.Select
    thisCell.Activate   'Activates initial range
    Application.ScreenUpdating = True

    msg = "All-at-once - Total Sheets: " & Format(Sheets.Count, "#,###")
    Debug.Print msg & " - Time: " & Format(Timer - t, "0.000") & " sec"
    'All-at-once - Total Sheets:   101 - Time:  2.469 sec
    'All-at-once - Total Sheets:   501 - Time: 13.484 sec
    'All-at-once - Total Sheets: 1,001 - Time: 29.137 sec
End Sub

Sub DeleteCols()
    Dim sh As Worksheet, t As Double, msg As String

    t = Timer
    For Each sh In Worksheets
        sh.Columns("AZ").Delete
        sh.Columns("AM").Delete
        sh.Columns("H").Delete
        sh.Columns("G").Delete
        sh.Columns("D").Delete
        sh.Columns("B").Delete
    Next

    msg = "One-by-one - Total Sheets: " & Format(Sheets.Count, "#,###")
    Debug.Print msg & " - Time: " & Format(Timer - t, "0.000") & " sec"
    'One-by-one - Total Sheets:   101 - Time:  3.609 sec
    'One-by-one - Total Sheets:   501 - Time: 26.633 sec
    'One-by-one - Total Sheets: 1,001 - Time: 72.164 sec
End Sub

Public Sub MakeWS()
    Dim i As Long

    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets
        For i = .Count To 1000
            .Item(1).Copy After:=.Item(i)
            ActiveSheet.Name = i + 1
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Тестовые листы (все одинаковые)

До

Before

* * После того, как тысяча двадцать-один * * тысяча двадцать-два

After

0 голосов
/ 08 мая 2018

Подход через массив и удаление "назад"

Sub DeleteCols() 
    Dim sh As Worksheet 
    Dim arr as Variant
    arr = Array("AZ", "AM", "H", "G", "D", "B")
    For Each sh In Worksheets 
        For Each element in arr
            sh.Columns(element).Delete
        Next
    Next 
End Sub
0 голосов
/ 08 мая 2018

небольшая корректировка, которую я бы внес в приведенные выше ответы:

Попробуйте удалить все сразу, как это:

Sub DEL()

Dim SHT As Worksheet
For Each SHT In Worksheets
    SHT.Range("B:B,D:D,G:G,H:H,AM:AM,AZ:AZ").EntireColumn.Delete
Next SHT

End Sub

Редактировать: я вижу, что мое предложение уже реализовано в ответе, поэтому я добавлю еще один вариант, который вы можете сделать без всякого цикла (это должно быть быстрее):

Sheets.Select 'Selects all sheets at once
Range("B:B,D:D,G:G,H:H,AM:AM,AZ:AZ").Select 'Select all the appropriate columns you want to delete at once
Selection.Delete Shift:=xlToLeft 'Deletes all columns on all sheets at once

У вас останется выбор листов и столбцов, с которых вы должны отменить.

0 голосов
/ 08 мая 2018

Попробуйте это:

Sub DeleteCols()
    Dim sh As Worksheet
    'as mentioned in comments by FunThomas, deleting should be done "backwards", i.e. for right to left
    For Each sh In Worksheets
        sh.Columns("AZ").Delete
        sh.Columns("AM").Delete
        sh.Columns("H").Delete
        sh.Columns("G").Delete
        sh.Columns("D").Delete
        sh.Columns("B").Delete
    Next
End Sub

В качестве альтернативы вы можете использовать:

Sub ClearCols()
    Dim sh As Worksheet
    For Each sh In Worksheets
        sh.Columns("B").Clear
        sh.Columns("D").Clear
        sh.Columns("G").Clear
        sh.Columns("H").Clear
        sh.Columns("AM").Clear
        sh.Columns("AZ").Clear
    Next
End Sub

Другой способ (предложенный @Peh):

sh.Range("B:B,D:D,G:H,AM:AM,AZ:AZ").Delete

, что должно быть быстрее для многих столбцов (вы можете использовать метод Clear аналогично).

...