如何简化多列筛选后用Subtotal求和的重复VBA代码

Got it, let's clean up that repetitive VBA code! The key here is to eliminate the copy-pasted lines by using an array to map your source columns to the target cells, then looping through that array. This makes your code way easier to maintain—if you need to add or remove columns later, you just update the array instead of editing 10+ identical lines.

Simplified Code #

Sub CalculateFilteredSums()
    Dim srcWS As Worksheet
    Dim destWS As Worksheet
    Dim sourceCols As Variant
    Dim i As Integer
    Dim lastRow As Long
    Dim targetCell As String
    
    ' Set references to your worksheets (change "SourceSheet" to your actual data sheet name)
    Set srcWS = ThisWorkbook.Worksheets("SourceSheet") ' Assumes your AP/BT/CZ columns live here
    Set destWS = ThisWorkbook.Worksheets("Sheet2")
    
    ' Array of columns you want to sum (matches the order of your original code)
    sourceCols = Array("AP", "BT", "CZ", "EE", "FK", "GP", "HV", "JB", "KG", "LM", "MR", "NX")
    
    ' Loop through each column in the array
    For i = LBound(sourceCols) To UBound(sourceCols)
        ' Get the last used row in the current source column (starting from row 2)
        lastRow = srcWS.Range(sourceCols(i) & "2").End(xlUp).Row
        ' Ensure we never go above row 2 (prevents errors if the column is empty)
        lastRow = WorksheetFunction.Max(lastRow, 2)
        
        ' Calculate target cell: B10, C10, ..., M10 (66 is ASCII for "B", i increments to shift columns)
        targetCell = Chr(66 + i) & "10"
        
        ' Assign the Subtotal result to the target cell
        destWS.Range(targetCell).Value = WorksheetFunction.Subtotal(9, srcWS.Range(sourceCols(i) & "2:" & sourceCols(i) & lastRow))
    Next i
    
    ' Clean up object references
    Set srcWS = Nothing
    Set destWS = Nothing
End Sub

Key Improvements #

• No more repetition: All your source columns are stored in a single array—adding/removing columns takes one line instead of copying entire code blocks.
• Reliable worksheet references: We explicitly define the source and destination sheets, avoiding bugs caused by relying on the active sheet (which can change if the user clicks elsewhere mid-macro).
• Error prevention: The WorksheetFunction.Max(lastRow, 2) ensures we never try to sum a broken range like AP2:AP1 if the column is empty.
• Better readability: The loop makes it clear what's happening for each column, instead of scanning 12 identical lines to find a change.

Quick Notes #

• Replace "SourceSheet" with the actual name of the worksheet where your AP, BT, etc., columns are located (your original code used the active sheet, which isn't reliable).
• If you ever need to change the target row (from 10 to something else), just update the 10 in targetCell = Chr(66 + i) & "10".

内容的提问来源于stack exchange，提问作者Sekar Naidu