在每一行旁边添加一个sum，表示sub

Question

所以我有一组每月更新的数据。在电子表格中，数据按行分组，在每个块之后有一条用于小计的线，在底部有一条对所有小计进行合计的线。

我想添加一个代码，以便将上面的所有行添加到前面的行中，以便将数据求和到显示为“sub”的行中。

例如。

清洁8000

横扫2000年

垃圾5000

小计15000 <-以上三项之和

Chipseal 6000

沥青3000

铣削5000

小计14000 <-芯片密封、沥青和铣削的总和

总计29000 <-小计的总和

帮助!

Answer 1

试一试发布的代码。我假设你的商品描述在'A‘栏，你的成本在'B’栏。它所做的是将一个间接总和放在它找到的每个'SUB TOTAL‘字符串旁边的'B’列中(以这种方式键入，忽略大小写)。我还假设这些值从第1行开始，您可能不希望这样做。我累积了一个sum字符串，并将其放在紧接我找到的最后一个小计行之后的行中。每个小计单元格都将有一个青色背景和一个上边框。大概您可以从这一点继续，并对其进行修改以满足您的需要。

Function findSubTotalRows(lastRow As Integer) As Collection
  Dim regEx As New RegExp
  Dim subTotCols As Collection

  regEx.Global = True
  regEx.IgnoreCase = True
  regEx.Pattern = "^SUB TOTAL$"

  Dim row As Integer
  Dim val As String
  Set subTotCols = New Collection
  For row = 1 To lastRow:
    val = Trim(Cells(row, 1).Value)
    Set mat = regEx.Execute(val)
    If mat.Count = 1 Then
      subTotCols.Add row
    End If
  Next

  Set findSubTotalRows = subTotCols
End Function


Sub sum_up_subtotals()
 Dim lastRow As Integer
 Dim cols As Collection

 ' Find last row in column and all sub total rows
 lastRow = Range("A1000").End(xlUp).row
 Set cols = findSubTotalRows(lastRow)

 Dim prevRow As Integer: prevRow = 0
 Dim numRng As Integer
 Dim totStr As String: totStr = "=SUM("
 For row = 1 To cols.Count:
   thisRow = cols(row)
   numRng = thisRow - prevRow - 1
   With Cells(thisRow, 2)
     .Formula = "=SUM(INDIRECT(ADDRESS(ROW()-" & CStr(numRng) & ",COLUMN())&"":""&ADDRESS(ROW()-1,COLUMN())))"
     .Interior.Color = vbCyan
     .NumberFormat = "$#,##0.00"
     .Borders(xlEdgeTop).LineStyle = xlContinuous
   End With
   prevRow = thisRow
   totStr = totStr & "B" & thisRow & ","
 Next

 totStr = Mid(totStr, 1, Len(totStr) - 1) & ")"
 Cells(thisRow + 1, 2).value = totStr

End Sub

这样做的好处是，你可以在每个小计段中插入额外的行，或者添加新的小计段，运行宏，它应该会显示适当的新和。

它对我很有效，但我只是用你提供的数据进行了尝试。请注意，您必须启用正则表达式才能正常工作。

Answer 2

别担心，伙计们，我发现了一个更简单的代码，它遍历每一行，查找"TOTAL“，并在该行中添加一个求和公式。然后，起始行变为小计行下面的行，并且该过程再次开始。

在本例中，ws被定义为工作表，firstRow和x是整数，lastrow是一个长整型

firstRow = 4
For x = 4 To lastRow
    If ws.Range("C" & x) Like "*TOTAL*" Then
        ws.Range("E" & x).Formula = "=sum(E" & firstRow & ":E" & x - 1 & ")"
        firstRow = x + 1
    End If
Next x