Excel Макрос: Суммировать ячейки, и последующее очистить.

Автор mariner14, 26 марта 2016, 21:08

mariner14

Добрый день. Нужна помощь.
Я прикрепляю файл, чтобы наглядно видно было. В файле выделил столбцы синим.
Мне надо чтобы в столбец М просуммировались все ячейки столбцов N и O, потом чтобы формула сумм в столбце М сохранилась как значение. Следующее действие:  копирование столбца О в столбец N, и следующее действие: очистка столбца О.

Администратор

Макрос. Версия от 27.03.2016 17:14
Sub Сумма()

    Dim arrM(), arrNO(), strHeader As String
    Dim lr As Long, i As Long
   
   
    '1. Отключение монитора (чтобы ускорить работу макроса).
    Application.ScreenUpdating = False
   
    '2. Копирование данных в массив (чтобы ускорить работу макроса).
    ' Поиск последней строки в столбцах N:O.
    lr = Columns("N:O").Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
    ' Копирование данных в массив.
    arrNO() = Range("N3:O" & lr).Value
   
    '3. Создание ячеек в массиве "arrM" (сначала в него запишутся суммы).
    ReDim arrM(1 To UBound(arrNO, 1), 1 To 1)
   
    '4. Сложение и запись сумм в массив "arrM".
    For i = 1 To UBound(arrNO, 1) Step 1
        arrM(i, 1) = arrNO(i, 1) + arrNO(i, 2)
    Next i
   
    '5. Вставка сумм на лист.
    Range("M3").Resize(UBound(arrM, 1), 1).Value = arrM()
   
    '6. Перестановка столбцов. В умной таблице нельзя переставить столбцы, а можно создавать и удалять столбцы.
    ' Запоминания заголовка столбца N.
    strHeader = Range("N2").Value
    ' Вставка нового столбца.
    Columns("P").Insert
    ' Удаление столбца N.
    Columns("N").Delete
    ' Переименование заголовка у нового столбца.
        ' Сразу это сделать нельзя, т.к. в умной таблице не может быть двух одинаковых заголовков.
    Range("O2").Value = strHeader
   
    '7. Включение монитора.
    Application.ScreenUpdating = True
   
    '8. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub
[свернуть]

mariner14

Да все получилось, сейчас буду тянуть на другие столбцы.
Спасибо большое