使列数组动态化

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