Question

首先：我道歉，因为我在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

这很好用，但我不确定如何对创建的行做任何事情。救命？谢谢！

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

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

VBA组并插入摘要行

1 个答案: