Question

我正在尝试创建一个宏来选择和分组一定数量的单元格并实现一些公式，下面包含一个简单的示例图片。唯一确定范围的是A栏。

假设活动单元格位于第2行和第9行之间，宏应该能够找出第1行和第10行是该范围的边界，因为A列中存在值，因此创建和选择从第2行到第9行的范围。我试图循环遍历单元格，以找到A列中具有活动值的第一行。在确定范围/组，计算这些行的乘积并完成它的公式之后，计算该组标题行中的那些产品的总和（在A列中具有活动值的上排）。

我已经将我的代码包含到目前为止，经过一些试验和错误以及谷歌搜索/搜索此论坛上的类似问题，但我的代码似乎仍然没有像我想要的那样工作。我不太了解VBA /脚本并没有真正帮助：）

下面包含一张图片，其中所需生成的公式为蓝色。

string-like

Answer 1

请尝试此代码。

Sub SumGroup()
    ' 12 Jan 2018

    Dim Rng As Range
    Dim Rstart As Long, Rend As Long
    Dim R As Long

    R = ActiveCell.Row
    If Len(Cells(R, "A").Value) Then R = R + 1
    Rstart = R
    Do Until Len(Cells(Rstart - 1, "A").Value)
        Rstart = Rstart - 1
    Loop
    Rend = R
    R = Cells(Rows.Count, "D").End(xlUp).Row
    Do Until Len(Cells(Rend + 1, "A").Value)
        Rend = Rend + 1
        If Rend = R Then Exit Do
    Loop

    Set Rng = Range(Cells(Rstart, "H"), Cells(Rend, "H"))
    With Rng
        .Formula = "=PRODUCT(RC[-4]:RC[-1])"
        .NumberFormat = "0.00"
        Cells(Rstart - 1, .Column + 1).Formula = "=SUM(" & .Address & ")"
        Cells(Rstart - 1, .Column + 1).NumberFormat = "0.00"
    End With
End Sub

Answer 2

这适用于您在一张纸上拥有的许多群组。如果用户选择经过最后一个使用行的单元格，那么它将假设它们意味着最后一个组

Sub tester()

    Dim myRow As Long
    Dim topRow As Long
    Dim botRow As Long
    Dim lastRow As Long

With ActiveSheet

    myRow = Selection.Row   ' get selected row
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row ' get last row in col A
    If lastRow <= myRow Then myRow = lastRow - 1 ' check that selected row is not past the last row

RETRY:
    topRow = myRow      ' initiate top and bottom row variables to same as select row
    botRow = myRow + 1

    Do While .Cells(topRow, 1).Value = "" ' cycle up until finds entry
        topRow = topRow - 1
    Loop

    Do While .Cells(botRow, 1).Value = "" ' cycle down until finds entry
        botRow = botRow + 1
    Loop

    topRow = topRow + 1 ' correct range
    botRow = botRow - 1

    If topRow - 1 = botRow Then myRow = myRow - 1: GoTo RETRY ' if user selected last entry in group in col A then it'll assume this was toprow, correct selection row and try again.

    With .Range(Cells(topRow, 8).Address, Cells(botRow, 8).Address)
        .Formula = "=PRODUCT(RC[-4]:RC[-1])"
        .NumberFormat = "0.00"
    End With

    .Range("I" & topRow - 1).Formula = "=SUM(" & Cells(topRow, 8).Address & ":" & Cells(botRow, 8).Address & ")"

End With

End Sub

Answer 3

我相信下面的代码会达到您的期望：

Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your Sheet, change Sheet1 as required
LastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
'find the last row in column D
ws.Cells(1, 9).FormulaR1C1 = "=SUM(R[1]C[-1]:R[50]C[-1])"
'enter the Sum formula on row 1 column 9, Range I1
For i = 1 To LastRow 'loop from row 1 to last
    If ws.Cells(i, 7) <> "" Then ws.Cells(i, 8).FormulaR1C1 = "=PRODUCT(RC[-4]:RC[-1])"
    'if there is data on Column 7 (G) then add formula to column 8 (H)
Next i
End Sub

计算动态范围的总和和分组

3 个答案: