Excel·VBA一键计算每月合计

《vba吧提问-怎么写每月合计的代码》，对表格中每月合计的行进行计算

Sub 选中列每月合计()
    '适用单/多列选中、单/多列部分选中
    Dim rng As Range, first_row, last_row, first_col, last_col, col_add, sum_j, i
    month_total = Array(1, "本月合计")  '每月合计所在列号
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    first_row = rng.Row     '选中区域开始行号
    last_row = first_row + rng.Rows.count - 1  '选中区域结束行号
    first_col = rng.Column  '选中区域开始列号
    last_col = first_col + rng.Columns.count - 1  '选中区域结束列号
    col_add = Split(Columns(first_col).Address(0, 0), ":")  '选中区域开始行号字母
    sum_j = first_row
    
    For i = first_row To last_row
        If InStr(Cells(i, CInt(month_total(0))), CStr(month_total(1))) > 0 Then
            Cells(i, first_col).Formula = "=SUM(" & col_add(0) & sum_j & ":" & col_add(0) & i - 1 & ")"
            If last_col > first_col Then  '单列AutoFill报错
                Cells(i, first_col).AutoFill Destination:=Range(Cells(i, first_col), Cells(i, last_col))
            End If
            Range(Cells(i, first_col), Cells(i, last_col)).Value = Range(Cells(i, first_col), Cells(i, last_col)).Value
            Range(Cells(i, first_col), Cells(i, last_col)).Interior.Color = vbYellow  '清除公式，标记颜色
            sum_j = i + 1  '更新值避免重复计算
        End If
    Next
    
End Sub

举例

自动按月合计

参照《Excel·VBA选中列一键计算小计总计》，对上面的代码改为自动按月合计，无需事先在每个月份后手动添加“本月合计”行，使用更加方便

Sub 选中列自动每月合计()
    '适用单/多列选中、单/多列部分选中；上一个sub的自动按月版
    Dim key_col&, rng As Range, i&, j&, k&
    Dim first_row&, last_row&, first_col&, last_col&, start_row&, end_row&
'--------------------参数填写：key_col都为数字
    key_col = 1    '日期列号，对连续相同月份的进行合计；非日期不统计
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    first_row = rng.row     '选中区域开始行号
    last_row = first_row + rng.Rows.Count - 1  '选中区域结束行号
    first_col = rng.column  '选中区域开始列号
    last_col = first_col + rng.Columns.Count - 1  '选中区域结束列号
    
    With ActiveSheet
        start_row = first_row: end_row = last_row + 1  'end_row+1方便最后一个区域计算
        Do
            If TypeName(.Cells(start_row, key_col).Value) <> "Date" Then
                start_row = start_row + 1
            Else
                month_s = Format(.Cells(start_row, key_col), "yyyy.mm")  '年月
                For j = start_row + 1 To end_row
                    month_t = Format(.Cells(j, key_col), "yyyy.mm")
                    If TypeName(.Cells(j, key_col).Value) <> "Date" Or month_t <> month_s Then  '非日期、非同月
                        .Rows(j).Insert
                        .Cells(j, key_col) = month_s & "合计"
                        For k = first_col To last_col
                            .Cells(j, k).FormulaR1C1 = "=SUM(R[-" & j - start_row & "]C:R[-1]C)"
                        Next
                        '也可清除公式仅保留结果
                        Range(.Cells(j, first_col), .Cells(j, last_col)).Value = Range(.Cells(j, first_col), .Cells(j, last_col)).Value
                        start_row = j + 1: end_row = end_row + 1  '开始、结束行号更新值
                        Exit For  '结束for循环
                    End If
                Next
            End If
        Loop Until start_row >= end_row
    End With
    Debug.Print "按月合计行插入完成"
End Sub