Question

我有以下代码根据动态行范围在特定列的底部运行总和公式。我的局限是我必须定义我想要发生的列。如何根据包含数据的最后一列使其动态化？

由于

 Option Explicit

Sub Sum()

Dim WS As Worksheet

For Each WS In ThisWorkbook.Worksheets
    If WS.Name <> "Master" And WS.Name <> "How to" And WS.Name <> "Template" Then

     Dim CurCal As XlCalculation
     Dim wb As Workbook, colsLastRow As Long
     Dim cols As Variant, SumCols As Long, colsArray As Variant
     Dim biggestRow As Long
     Dim shNAMES As Range

        Application.ScreenUpdating = False
        CurCal = Application.Calculation
        Application.Calculation = xlCalculationManual

        biggestRow = 1

        Set wb = ThisWorkbook

        colsArray = Array("L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ")

        For Each cols In colsArray
        colsLastRow = WS.Cells(Rows.Count, cols).End(xlUp).Row
        If colsLastRow > biggestRow Then
        biggestRow = colsLastRow + 1
        End If
        Next cols

        For Each cols In colsArray
        colsLastRow = WS.Cells(Rows.Count, cols).End(xlUp).Row
        WS.Cells(biggestRow, cols).Formula = "=SUM(" & cols & "9:" & cols & colsLastRow & ")"
        Next cols

        WS.Range("B" & biggestRow).Value = "TOTAL"

        WS.Cells(3, 3).Formula = "=LOOKUP(2,1/(N:N<>""""),N:N)"

        Application.ScreenUpdating = True
        Application.Calculation = CurCal
    End If
Next WS
End Sub

Answer 1

类似的东西：

忽略没有足够行或列的工作表

Option Explicit
Public Sub test()
    Application.ScreenUpdating = False
    Dim CurCal As Variant
    CurCal = Application.Calculation
    Application.Calculation = xlCalculationManual
    Dim i As Long, ws As Worksheet, lastColumn As Long, lastRow As Long
    Const startRow As Long = 9                   '<=====change this to sum from a different row
    Const startColumn As Long = 12               '<====change this for column to start putting totals at
    For Each ws In ThisWorkbook.Worksheets
        With ws
            On Error Resume Next
            lastColumn = GetLastColumn(ws)
            lastRow = GetLastRow(ws)
            If .Name <> "Master" And .Name <> "How to" And .Name <> "Template" Then
                For i = 1 To lastColumn - startColumn + 1
                    .Cells(lastRow, i + startColumn - 1).Offset(1, 0).Formula = "=Sum(" & .Range(.Cells(startRow, i + startColumn - 1), .Cells(lastRow, i + startColumn - 1)).Address & ")"
                Next i
                If ws.UsedRange.Rows.Count > startRow - 1 And ws.UsedRange.Columns.Count > startColumn - 1 Then
                    ws.Range("B" & lastRow + 1) = "TOTAL"
                    ws.Cells(3, 3).Formula = "=LOOKUP(2,1/(N:N<>""""),N:N)"
                End If
            End If
            On Error GoTo 0
        End With
    Next ws
    Application.ScreenUpdating = True
    Application.Calculation = CurCal
End Sub

Public Function GetLastColumn(ByVal ws As Worksheet) As Long
    If Application.WorksheetFunction.Subtotal(103, ws.UsedRange) > 0 And ws.Cells.SpecialCells(xlCellTypeLastCell).Column > 11 Then
        GetLastColumn = ws.Cells.SpecialCells(xlCellTypeLastCell).Column
    End If
End Function

Public Function GetLastRow(ByVal ws As Worksheet) As Long
    If Not Application.WorksheetFunction.Subtotal(103, ws.UsedRange) = 0 And ws.Cells.SpecialCells(xlCellTypeLastCell).Row > 8 Then
        GetLastRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
    End If
End Function

Answer 2

如果您的范围是连续的，您可以找到第一列和最后一列：

只需调整rng范围以适合您的表数据范围

Option Explicit

Sub test()

Dim first_col_letter As String
Dim first_col_number As Long
Dim last_col_letter As String
Dim last_col_number As Long

Dim rng As Range
Set rng = ActiveCell.CurrentRegion

    With rng

        first_col_letter = Chr(.Columns(1).Column + 64)
        first_col_number = .Columns(1).Column

        last_col_letter = Chr(.Columns(.Columns.Count).Column + 64)
        last_col_number = .Columns(.Columns.Count).Column

    End With

End Sub

使列数组动态

2 个答案: