宏在一列中创建多个子总计

Question

任何人都可以帮助我使用此宏在一列中创建多个子总计吗？任何帮助都会很棒。我在Y列中有一组数字，从第16行开始。 数据每三行列出一次，直到该部分结束，然后有大约三十行的间隙，然后再次出现。我想创建一个宏来计算每个部分中有多少个＆gt; 45。将总共​​2行放在每个部分的最后一个数据点之下。在同一行的第X列中，数字＆gt; 45

Sub Sample()
    Dim result As Long, firstrow As Long, lastrow As Long
    Dim ws As Worksheet
    Dim rng As Range


    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Find Lastrow in Col Y
        lastrow = .Range("Y" & .Rows.Count).End(xlUp).Row
        '~~> Set First row
        firstrow = 16

        '~~> Set your range
        Set rng = .Range("Y" & firstrow & ":Y" & lastrow)

        '~~> Put relevant values
        .Range("x" & lastrow + 2).Value = "Total>45"
        .Range("y" & lastrow + 2).Value = _
        Application.WorksheetFunction.CountIf(rng, ">45")

    End With
End Sub

Answer 1

尝试以下程序

并向后循环到ROW = 1，如下所示：

Sub setTotals()
Dim iRow As Integer
Dim iLastRow As Integer
Dim sFormulaTargetAddress As String

iLastRow = ActiveSheet.Range("Y" & ActiveSheet.Rows.Count).End(xlUp).Row


iRow = iLastRow
Do Until iRow = 1
If Range("Y" & iRow).Value <> "" Then
    '
    ' define the section
    sFormulaTargetAddress = "Y" & Range("Y" & iRow).End(xlUp).Row & ":Y" & iRow & ""
    '
    ' Put in the COUNTIF > 45 of the current section...
    '
    Range("Y" & iRow + 2).Formula = "=COUNTIF(" & sFormulaTargetAddress & ","">45"")"
    '        '
    'Range("X" & iRow + 2).Formula = "=COUNTIF(" & sFormulaTargetAddress & ","">45"")"
    Range("X" & iRow + 2).value="Numbers > 45"
    '
    ' find the next section
    iRow = Range("Y" & iRow).End(xlUp).Row
    If Range("Y" & iRow) <> "" Then iRow = Range("Y" & iRow).End(xlUp).Row
Else
    iRow = Range("Y" & iRow).End(xlUp).Row
End If
Loop


End Sub

HTH

菲利普