动态列和动态行的自动求和循环通过工作表和循环工作簿

Question

我有一份固定损益表，需要所有单元格总数的公式。

我需要一个vba代码： 首先，自动求和（左侧两个单元格）Jan Total 列，将公式复制到最后一个总计行（销货成本总计）；在下一个自动求和（左侧四个单元格）二月总计列中，将公式复制到最后一个总计行（销售商品成本总计），根据需要循环多次。下一个自动求和总计列（一月、二月、三月等的单元格值）。

接下来，在 A 列中，找到第一个带有“总计”的单元格，在单元格上方自动求和，复制公式并粘贴到右侧。循环直到最后一行（总销售成本）

最后，对工作簿中的每个工作表（x、y、z 等）重复上述操作。

对于列，我手动对列进行自动求和、复制、粘贴公式。 对于行，我到达第一个需要自动求和的单元格。

Selection.Copy
Range(Selection, Selection.End(xlToRight)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, -1).Range("A1").Select
Cells.Find(What:="total", After:=ActiveCell, LookIn:=xlFormulas2, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Range("A1").Select

这可行，但很耗时。

Answer 1

这里是应用

columns

公式的代码。

我不确定

autosum above cells

的逻辑是什么。例如总收入

Option Explicit

Sub AutoColSum()
    Dim i As Long, aMth(1 To 12) As String
    Dim lastRow As Long, c As Range, ColCnt As Long
    Dim ColRng As Range, SumRng As Range
    Const HEADER_ROW = 4
    Const GRAND = "Grand Total"
    For i = 1 To 12
        aMth(i) = Format(DateSerial(2023, i, 1), "MMM yyyy Total")
    Next
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    If lastRow > HEADER_ROW + 1 Then
        For i = 1 To 12
            Set c = Range(HEADER_ROW & ":" & HEADER_ROW + 1).Find(What:=aMth(i), LookIn:=xlValues, _
                LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not c Is Nothing Then
                If i = 1 Then
                    Set SumRng = c.Offset(2)
                Else
                    Set SumRng = Union(SumRng, c.Offset(2))
                End If
                ColCnt = IIf(i = 1, 2, 4)
                Set ColRng = Range(Cells(HEADER_ROW + 2, c.Column), Cells(lastRow, c.Column))
                ColRng.FormulaR1C1 = "=SUM(RC[-" & ColCnt & "]:RC[-1])"
            End If
        Next
        Set c = Cells(HEADER_ROW, Columns.Count).End(xlToLeft)
        If StrComp(c.Value, GRAND, vbTextCompare) = 0 Then
            Set ColRng = Range(Cells(HEADER_ROW + 2, c.Column), Cells(lastRow, c.Column))
            ColRng.Formula = "=SUM(" & SumRng.Address(0, 0) & ")"
        End If
    End If
End Sub