Excel 各部分的总和工作不正常

我正在做一个循环，在一张工作表中选择一个特定的页眉，并对页眉下的数字求和。标头在不同的类别下可用，因此循环会运行以查找标头-第二个循环中的Sumtotal无法正常工作

Sub LoopText()
    Dim rFirst As Range, r As Range
    Dim A As Range
    Dim Sumtotal As Variant
    
    Sheets("FA_CP_Report").Select
    Range("A1").Select
    Set A = Range("F:G")
   Do
      If rFirst Is Nothing Then
         Set rFirst = A.Find(What:="Sub-ledger")
         Set r = rFirst
      Else
         Set r = A.Find(What:="Sub-ledger", After:=r)
         If r.Address = rFirst.Address Then Exit Do
      End If
         r.Select
        Selection.End(xlDown).Select
        Do
            Sumtotal = Sumtotal + ActiveCell
            ActiveCell.Offset(1, 0).Select
        Loop Until IsEmpty(ActiveCell)
        
        ActiveCell.Offset(1, 0).Select
        ActiveCell.Value = Sumtotal
        
   Loop
End Sub

这应该可以做到：

Sub LoopText()
    Dim arr, sh As Worksheet
    Set sh = ThisWorkbook.Sheets("FA_CP_Report")
    arr = sh.Range("G1:G" & sh.Cells(Rows.count, 1).End(xlUp).Row + 1).Value2 'load source
    
    Dim j As Long, subsum As Long, count As Boolean
    For j = 1 To UBound(arr)
        If VarType(arr(j, 1)) = 8 Then
            count = True
        ElseIf count = True And arr(j, 1) <> "" Then
            subsum = subsum + arr(j, 1)
        Else
            sh.Cells(j + 1, 7) = subsum
            count = False
            j = j + 2
            subsum = 0
        End If
    Next j
End Sub

子循环文本（）
Dim arr，sh As工作表
Set sh=ThisWorkbook.Sheets（“FA\U CP\U报告”）
arr=sh.Range（“G1:G”和sh.Cells（Rows.count，1）。End（xlUp）。Row+1）。Value2'加载源
长度为Dim j，长度为subsum，计数为Boolean
对于j=1至UBound（arr）
如果VarType（arr（j，1））=8，那么
计数=真
ElseIf count=True且arr（j，1）“，则
subsum=subsum+arr（j，1）
其他的
sh.Cells（j+1,7）=subsum
计数=假
j=j+2
subsum=0
如果结束
下一个j
端接头

或在多列版本中：

Sub LoopTextMulti()
    Dim arr, sh As Worksheet
    Set sh = ThisWorkbook.Sheets("FA_CP_Report")
    arr = sh.Range("G1:H" & sh.Cells(Rows.count, 1).End(xlUp).Row + 1).Value2 'load source
    
    Dim j As Long, i As Long, subsum As Long, count, startCl As Long
    startCl = 6
    ReDim count(1 To UBound(arr, 2))
    For j = 1 To UBound(arr)
        For i = 1 To UBound(arr, 2)
            If VarType(arr(j, i)) = 8 Then
                count(i) = 1
            ElseIf count(i) <> Empty Then
                If arr(j, i) <> "" Then
                    count(i) = count(i) + arr(j, i)
                Else
                    sh.Cells(j + 1, startCl + i) = count(i) - 1
                    count(i) = Empty
                End If
            End If
        Next i
    Next j
End Sub

Sub-LoopTextMulti（）
Dim arr，sh As工作表
Set sh=ThisWorkbook.Sheets（“FA\U CP\U报告”）
arr=sh.Range（“G1:H”和sh.Cells（Rows.count，1）。End（xlUp）。Row+1）。Value2'加载源
Dim j为长，i为长，subsum为长，count为长，startCl为长
startCl=6
重拨计数（1到UBound（arr，2））
对于j=1至UBound（arr）
对于i=1至UBound（arr，2）
如果VarType（arr（j，i））=8，那么
计数（i）=1
如果计数（i）为空，则
如果arr（j，i）“，那么
计数（i）=计数（i）+arr（j，i）
其他的
sh.单元格（j+1，startCl+i）=计数（i）-1
计数（i）=空
如果结束
如果结束
接下来我
下一个j
端接头

您的要求并不完全清楚，但这种变化假设“F”列和“G”列中每次出现“明细分类账”时，下面的单元格中都会出现一组数字，您需要的是在连续值集的底部添加这些数字的小计

Sub LoopText()
    Dim rFirst As Range, r As Range
    Dim rTot As Range, rVal As Range
    Dim SearchIn As Range
    Dim SLtotal As Variant
    Dim GLtotal As Variant
    
    Sheets("FA_CP_Report").Select
    Set SearchIn = Range("F:F")
    Do
        If rFirst Is Nothing Then
            Set rFirst = SearchIn.Find(What:="Sub-ledger")
            If rFirst Is Nothing Then Exit Do '===>
            Set r = rFirst
        Else
            Set r = SearchIn.Find(What:="Sub-ledger", After:=r)
            If r.Address = rFirst.Address Then Exit Do '===>
        End If
        Set rTot = Range(r.Offset(1, 0), r.End(xlDown)) ' Setup zone to sum
        SLtotal = 0
        GLtotal = 0
        For Each rVal In rTot
            SLtotal = SLtotal + rVal.Value
            GLtotal = GLtotal + rVal.Offset(1, 0).Value
        Next rVal
        r.End(xlDown).Offset(2, 0).Value = SLtotal ' Add subtotals
        r.End(xlDown).Offset(2, 1).Value = GLtotal '
    Loop

End Sub

---

编辑：更新以匹配示例

您的代码没有求和？只需选择标题栏中的最后一个单元格（Selection.End（xlDown）.Select），检查下一个单元格是否为空，然后将此值粘贴到下一行。在第二次迭代中，“after:=r”始终存在，即使它们是要捕获的第二个头。我将用另一种方法看一看，“工作不好”不足以说明问题，任何人都没有信心解决它。最好准确地描述你们想要什么，然后你们实际上得到了什么。实际上问题是我们有“FA_CP_Report”表，其中包含三个不同类别的“Sub-ledger”标题。我创建了一个循环来搜索标题，但无法汇总每个“明细账”标题下的数字。在头的第一次搜索中，我们可以得到sumtotal，但当它转到第二次和第三次搜索时，sumtotal是不正确的。如果Excel有一个功能可以为您这样做，为什么您要自己编程？我们必须对多个工作簿执行此操作。所以创建一个宏可以在几秒钟内完成所有的工作。嗨，Ceci，谢谢你的代码。这个密码不起作用。它只是通过细胞，但没有提供结果。你是什么意思？总额将打印在各列最后一行（“第1行中的明细账”）下的2行。arr=表（“FA_CP_报告”）。范围（“A1”）。CurrentRegion.Value2出现错误。哪个错误？我还编辑了代码，因为我认为我误解了你的目标。是否要计算标题的出现次数，而不是对标题右侧的数字求和？“标题”可以在列中的任何位置？G列中有3个“明细分类账”标题。我们希望对每个标题下的值求和，并显示总和。提供的代码仅合计第一个明细分类账。其他两个明细账总计为空。我的要求：在三个类别下的G列中有3个“明细账”标题。我们希望对每个标题下的值求和，并显示总和。提供的代码仅合计第一个明细分类账标题。其他两个明细分类账总计不正确。我的代码如何执行？谢谢。但它没有提供我所要求的结果；这不是我阅读您的描述的方式，我在您的代码中没有看到任何提示需要并行总账小计的内容。按照您的布局建议，我在小计中添加了一行间距。