Вставьте строку с итогом под каждой группой

Question

Мне нужно вставить строку с итогом и разрывом страницы под каждой группой.

Я попробовал следующее, чтобы вставить строку, однако он вставил более одной строки, когда мне нужен только один.

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 используется для выхода из цикла поэтому ваш код будет

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

Вот еще один метод, использующий встроенные промежуточные итоги 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

Answer 3

Это будет работать с более чем двумя разными строками в столбце A

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