VBA集团和插入总结行

Question

首先：我很抱歉，因为我花了很少的时间与VBA。我有这样的数据：

Amount |类别
2.00 | cat1
4.00 | cat1
3.00 | cat2
5.00 | CAT3

我想拥有它落得像：

金额|类别
2.00 | cat1
4.00 | cat1
合计：6.00 | cat1
3.00 | cat2
总数：3.00 | cat2
5.00 | cat3
总数：5.00 | CAT3

我发现插入行的代码是：

Sub InsertRowAtChangeInValue() 
Dim lRow As Long 
For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1 
    If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then Rows(lRow).EntireRow.Insert 
Next lRow 
End Sub 

这工作不错，但我不知道该怎么办与已创建的行什么。帮帮我？谢谢！

Answer 1

如果你还没有用VBA工作太多，那么任何简单的方法开始获得一些结构是记录一个宏你想要执行的步骤，并看看产生的代码。

请记住，宏记录一步一步地进行，因此记录总和丑陋的东西，如屏幕变化。由于录制的宏没有错误陷阱，我从来没有见过创建循环的录制宏的实例。

请记住，您的代码假定数据始终在当前工作表的A1中开始。

您需要添加一些代码才能获取您要查找的内容。我会将您的代码切换为：

Sub InsertRowAtChangeInValue() 
Dim lRow As Long 
Dim cRow As Long 
Dim sSum As Long 
Dim formula As String 
'Stops screen updating and improves run times 
Application.ScreenUpdate = False 
'Start at row 3 because row 1 is a header so row 2 is first line of data 
cRow = 3 
'sSum is the start of Sum. The first row you might sum is 2. 
sSum = 2 
'Because of the sums easier to step down instead of up 
'Add 2 to last row to allow for the last sum 
lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row + 2 
Do Until cRow = lRow 
    If Cells(cRow, "B") <> Cells(cRow - 1, "B") Then 
      Rows(cRow).EntireRow.Insert 
      Cells(cRow, "A").Select 
      'Insert the formula 
      ActiveCell.formula = "=""Total: """ & "& SUM(A" & sSum & ":A" & cRow - 1 & ")" 
      'Update column B 
      Cells(cRow, "B").Value = Cells(cRow - 1, "B") 
      'Increase the next sum to the row after the one you just added. 
      sSum = cRow + 1 
      'Increase the last row count 
      lRow = lRow + 1 
      'Check to make sure you are not at the bottom of the workbook 
      If cRow = 65536 Then 
       cRow = lRow 
      Else 
       cRow = cRow + 2 
      End If 
    Else 
      'Increment if the rows are the same in column B 
      'Check if you are at the bottom of the workbook 
      If cRow = 65536 Then 
       cRow = lRow 
      Else 
       cRow = cRow + 1 
      End If 
    End If 
Loop 
Application.ScreenUpdating = True 
End Sub 

我添加了一些注释来尝试解释发生了什么。