在每个组下插入总计行

我需要在每个组下面插入一个总计和一个分页符的行。

我尝试了以下插入行，但它插入多行，当我只想要一个。

Sub macro() Dim sh1 As Worksheet Dim i As Long, lastrow1 As Long Set sh1 = Worksheets("Sheet1") lastrow1 = sh1.Cells.SpecialCells(xlCellTypeLastCell).Row For i = 1 To lastrow1 If sh1.Cells(i, "A").Value = "sell" Then sh1.Cells(i, "A").EntireRow.Insert End If Next i End Sub 

Answer 1

我不是VBA的专家，但它肯定看起来像你的代码将插入一行每次发现“卖”，因此插入多行。

在插入行之后，尝试添加一个中断以使您脱离for循环。

希望这可以帮助。
AH请注意，在VBA Exit For是用来打破for循环，所以你的代码将是

 Set sh1 = Worksheets("Sheet1") lastrow1 = sh1.Cells.SpecialCells(xlCellTypeLastCell).Row For i = 1 To lastrow1 If sh1.Cells(i, "A").Value = "sell" Then sh1.Cells(i, "A").EntireRow.Insert Exit For End If Next i End Sub 

Answer 2

这将与列A中的两个以上不同的string一起工作

 Sub InsertTotals() Dim i As Long Dim lLastRow As Long Dim sh1 As Worksheet Set sh1 = ActiveWorkbook.Worksheets("Sheet1") lLastRow = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row For i = lLastRow + 1 To 2 Step -1 If sh1.Cells(i, 1).Value <> sh1.Cells(i - 1, 1).Value Then sh1.Cells(i, 1).EntireRow.Insert End If Next i End Sub 

Answer 3

这是另一种使用Excel内置小计的方法。 这不是为了插入行本身，但如果您的最终目标是小计列B，这可能更合适。

 Sub InsertSubtotals() Dim rTransactions As Range Dim sh1 As Worksheet Set sh1 = ActiveWorkbook.Worksheets("Sheet1") sh1.Range("A1").EntireRow.Insert sh1.Range("A1:B1").Value = Array("Type", "Amount") Set rTransactions = sh1.Range("A1", sh1.Cells(sh1.Rows.Count, 1).End(xlUp)) rTransactions.Resize(, 2).Subtotal 1, xlSum, Array(2) End Sub