在每個組下插入行總數

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是用來打破的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

這將在列兩個以上不同的字符串工作

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