excel - Separate Autosum Offsets or Individual Ranges For Selecting Active Cells Excel VBA

Question

I may have butchered that title but what I am trying to do is autosum (via my macro below) only certain columns based off of the offset below.

So where it finds "CCOIL", "COIL" or "DCOIL", it moves 4 columns over, sums, then moves 6 columns over and sums (10 different columns in total, eventually).

However with "RANGE", it adds a subtotal to every column between 4 & 10 in the example below, however I only want some columns to have subtotals. So is there a way to select multiple cells with multiple offsets ?

So something like

((Cell.Offset(0, 4)), (Cell.Offset(0, 6)), Cell.Offset(0,8)), Cell.Offset(0,10))).Activate

My code so far below:

For Each Cell In Range("E2:E" & findLastRow(.Range("A2")))
    If Cell.Value = "CCOIL" Or Cell.Value = "COIL" Or Cell.Value = "DCOIL" Then
        Range((Cell.Offset(0, 4)), (Cell.Offset(0, 10))).Activate
        ActiveCell.Formula = _
            "=SUM(" & Range(ActiveCell.Offset(-1, 0), ActiveCell.Offset(-1, 0).End(xlUp)).Address & ")"
    End If
Next Cell

Example Dataset

标签： excelvbaoffset

Answer 1

也许：

Dim rngX As Range, rngY As Range

For Each cell In Range("E2:E1000") 'example of range
    If cell.Value = "CCOIL" Or cell.Value = "COIL" Or cell.Value = "DCOIL" Then
        'Range((cell.Offset(0, 4)), (cell.Offset(0, 10))).Activate
        Set rngX = cell.Offset(0, 4)
        rngX.Formula = "=SUM(" & rngX.Offset(-1, 0).Address & ":" & rngX.Offset(-1, 0).End(xlUp).Address & ")"
        Set rngY = cell.Offset(0, 10)
        rngY.Formula = "=SUM(" & rngY.Offset(-1, 0).Address & ":" & rngY.Offset(-1, 0).End(xlUp).Address & ")"
    End If
Next cell