VBA组插入摘要行

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

金额| 类别
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 

这很好，但我不知道如何做任何事情与创build的行。 帮帮我？ 谢谢！

Answer 1

如果你对VBA没有太多的工作，那么任何简单的方法开始获得一些结构是logging你想要执行的步骤的macros观，并看看最终的代码。

请记住，macroslogging是一步一步来，因此logging总和丑陋的东西，如屏幕移位。 由于录制的macros没有错误陷阱，我从来没有见过创build循环的录制macros的实例。

请记住，您的代码假定数据始终在当前工作表的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 

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