Попытка вставить или удалить столбцы

Question

Я получаю:

Ошибка времени выполнения '1004' метод промежуточного итога класса Range не выполнен

Я записал макрос (и вручную добавил несколько кодов) скопировать данные, отсортировать их, подытожить и отформатировать некоторые строки промежуточных итогов. Макрос работает нормально при добавлении строк в таблицу необработанных данных («StaffingProjected»), но я не могу вставить или удалить столбцы. Когда я это делаю, я получаю ошибку, как описано в заголовке.

Sub Project()
'
' Project Macro
'

'
    Application.ScreenUpdating = False
    Sheets("Project").Cells.Clear
    Sheets("Project").Cells.RemoveSubtotal
    Sheets("Project").Cells.ClearFormats
    Sheets("Project").Cells.RowHeight = 13.5
    Sheets("StaffingProjected").Activate
    ActiveSheet.Cells.Select
    Selection.Copy
    Sheets("Project").Select
    Sheets("Project").Range("A1").Select
    ActiveSheet.Paste
    Cells.Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Project").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Project").Sort.SortFields.Add Key:=Range("B2:B58") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Project").Sort
        .SetRange Range("A1:HC58")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(6, 7, 8, 9, _
        10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, _
        36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, _
        62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, _
        88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110 _
        , 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, _
        130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149 _
        , 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, _
        169, 170, 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188 _
        , 189, 190, 191, 192, 193), Replace:=True, PageBreaks:=False, SummaryBelowData _
        :=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    Cells.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.RowHeight = 20
    ActiveSheet.Outline.ShowLevels RowLevels:=3
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

Отладка говорит, что проблема в блоке «Selection.Subtotal». Какова точная проблема, и что я могу изменить, чтобы я мог удалять / вставлять столбцы в мою таблицу необработанных данных («StaffingProjected»)?

Answer 1

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

Вы можете попытаться добавить это где-то в вашем модуле:

Sub deleteColumnNo(No As Integer)
   Columns(No).EntireColumn.Delete
End Sub

Sub AddColumn(Letter As String)
   Columns(Letter  + ":" + Letter ).Select
   Selection.Insert Shift:=xlToRight
End Sub

Затем введите те строки, где вам нужно удалить / добавить свой столбец :

Sub Project()
  '[...]
  CleanColumnNo 1  'delete the first column
  CleanColumnNo 2  'delete the second column
  AddColumn "B"    'add a column between A and B 
  '[...]
end sub

В любом случае, не стесняйтесь добавлять дополнительную информацию в следующий раз, у вас будут лучшие ответы.

Хорошего дня!