Автосумма VBA для каждого нового листа, добавленного в книгу - PullRequest
0 голосов
/ 16 октября 2018

Мой текущий VBA предоставляет функцию суммы для предварительно определенных столбцов в таблицах, которые указаны и определены в коде.Это прекрасно работает, однако я ежедневно добавляю новые рабочие листы в эту рабочую книгу, и поэтому не представляется возможным редактировать код каждый день, чтобы добавить новый рабочий лист и диапазон для его суммирования.

Есть ли способЯ могу отредактировать свой текущий код, чтобы он выполнял функцию суммирования для каждого отдельного листа в книге?Я приложил текущий код для справки ниже.

    Sub AutoSum()
Sheets("MASTER ACCOUNT REVENUE").Select
Range("D4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(2, 0).Select
Dim cel1 As String, cel2 As String
cel1 = ActiveCell.Offset(-2, 0).End(xlUp).Address
cel2 = ActiveCell.Offset(-1).Address
ActiveCell.Value = "=sum(" & (cel1) & ":" & (cel2) & ")"
End Sub

Ответы [ 2 ]

0 голосов
/ 16 октября 2018

Да, просто переберите листы.ПРИМЕЧАНИЕ: лучше избегать использования .Select / .Activate

Sub autoSum_AllSheets()
Dim ws As Worksheet
Dim cel1 As String, cel2 As String
Dim firstCel As Range

For Each ws In ActiveWorkbook.Worksheets
    With ws
        Set firstCel = .Range("D4").End(xlDown).Offset(2, 0)
        cel1 = firstCel.Offset(-2, 0).End(xlUp).Address
        cel2 = firstCel.Offset(-1).Address
        firstCel.Value = "=SUM(" & cel1 & ":" & cel2 & ")"
    End With
Next ws

End Sub

Примечание: я знаю о избыточности в деталях Offset(), но просто держу их вдля OP, чтобы увидеть, как легче избежать .Select / .Activate.

Редактировать: Чтобы перебрать группу столбцов, один (хотя и клудливый) способ - просто добавить буквы столбцов в массив:

Sub autoSum_AllSheets()
Dim ws As Worksheet
Dim cel1 As String, cel2 As String
Dim firstCel As Range

Dim cols() As Variant
cols = Array("D", "E", "F")

Dim i As Long
For Each ws In ActiveWorkbook.Worksheets
    With ws
        For i = LBound(cols) To UBound(cols)
            Set firstCel = .Range(cols(i) & "4").End(xlDown).Offset(2, 0)
            firstCel.Select
            cel1 = firstCel.Offset(-2, 0).End(xlUp).Address
            cel2 = firstCel.Offset(-1).Address
            firstCel.Value = "=SUM(" & cel1 & ":" & cel2 & ")"
        Next i
    End With
Next ws

End Sub

Обратите внимание, что если столбец делает не имеет какую-либо информацию в ячейке после 5-й строки, вы получите сообщение об ошибке (поскольку .XlDown идет до самой последней строки, и вы не можете Offset(2,0) оттуда.)

0 голосов
/ 16 октября 2018

Да, добавьте:

Dim wscount as long
dim i as long
     wscount = Activeworkbook.Worksheets.Count
 for i = 1 to wscount
Sheets(i).Select
Range("D4").Select
 Selection.End(xlDown).Select
ActiveCell.Offset(2, 0).Select
Dim cel1 As String, cel2 As String
cel1 = ActiveCell.Offset(-2, 0).End(xlUp).Address
cel2 = ActiveCell.Offset(-1).Address
ActiveCell.Value = "=sum(" & (cel1) & ":" & (cel2) & ")"
next i 

End Sub

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...