如果 ID 匹配，则在其他列中插入新行和总值

Question

我有一个大约有 19 列的电子表格，行数总是在变化。 A 列包含 "Item IDs"，N 列包含“已售商品数量”，O 列包含“商品数量”。我正在尝试创建一个宏，每当 A 列中的 "Item ID" 更改时插入一行，并合计“已售商品数量”和“商品数量”。如果可能的话，我还想将 "Item ID" 复制到这个新行中。如果有人能帮我解决这个问题，我将不胜感激。

更新：电子表格示例的屏幕截图见下方（我尝试 post 图片，但由于我是新手，我想我还没有这个级别的访问权限）。

电子表格现在的样子：

我希望电子表格如何处理运行宏：

Answer 1

最适合您的选项是 数据 ► 小计。是最省时的。

之前:

1. 小计在大纲组:

2. 详情：

之后：

Answer 2

ZygD，非常感谢你的帮助。我真的在寻找一个宏，因为这只是可能 7 个左右的宏之一，这些宏将被绑定到一个按钮解决方案中，供其他没有 time/knowledge 小计这些行的人使用。

我想出了一个将传播sheet复制到临时sheet的宏。在那个临时 sheet 中，每次 ID 更改时它都会添加一个灰色行，并小计上述 2 列...同时复制所有其他信息。然而，这导致 Excel 冻结了一段时间......所以我让它删除了除我需要的列之外的所有列，小计，并删除了除了灰色（小计）的行之外的所有行。这是我想出的宏（以防其他人正在寻找类似的东西）：

Sub SubTotal()

Dim i As Long
Dim numberOfRows As Long
Dim j

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Copies SellerTotals to SellerTotals(Temp)
Sheets("SellerTotals").Select
Sheets("SellerTotals").Copy Before:=Sheets("Pacing")
Sheets("SellerTotals (2)").Select
Sheets("SellerTotals (2)").Name = "SellerTotals(Temp)"
Worksheets("SellerTotals(Temp)").Activate

Range("B:M,P:T").Select
Selection.Delete Shift:=xlToLeft

' number of IDs
numberOfRows = Cells(Rows.Count, "A").End(xlUp).Row

' do bottom row first
Cells(numberOfRows + 1, 1).Value = Cells(numberOfRows, 1).Value
Cells(numberOfRows + 1, 2).FormulaR1C1 = "=SUMIF(R[-" & numberOfRows - 1 & "]C[-1]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[-1],""" & Cells(numberOfRows, 1).Value & """,R[-" & numberOfRows - 1 & "]C[0]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[0])"
Cells(numberOfRows + 1, 3).FormulaR1C1 = "=SUMIF(R[-" & numberOfRows - 1 & "]C[-2]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[-2],""" & Cells(numberOfRows, 1).Value & """,R[-" & numberOfRows - 1 & "]C[0]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[0])"

' convert to value
Cells(numberOfRows + 1, 2).Value = Cells(numberOfRows + 1, 2).Value
Cells(numberOfRows + 1, 3).Value = Cells(numberOfRows + 1, 3).Value

Range(Cells(numberOfRows + 1, 1), Cells(numberOfRows + 1, 3)).Interior.Color = RGB(192, 192, 192)

' insert blank row in between each group of IDs
' loop backwards because we are inserting rows
For i = numberOfRows To 3 Step -1
If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
  Cells(i, 1).EntireRow.Insert xlShiftDown

  ' copy ID name down
  Cells(i, 1).Value = Cells(i - 1, 1).Value

  ' put formula into Total & Total Cap field
  Cells(i, 2).FormulaR1C1 = "=SUMIF(R[-" & i - 1 & "]C[-1]:R[-" & i - (i - 1) & "]C[-1],""" & Cells(i, 1).Value & """,R[-" & i - 1 & "]C[0]:R[-" & i - (i - 1) & "]C[0])"
  Cells(i, 3).FormulaR1C1 = "=SUMIF(R[-" & i - 1 & "]C[-2]:R[-" & i - (i - 1) & "]C[-2],""" & Cells(i, 1).Value & """,R[-" & i - 1 & "]C[0]:R[-" & i - (i - 1) & "]C[0])"

  ' convert to value
  Cells(i, 2).Value = Cells(i, 2).Value
  Cells(i, 3).Value = Cells(i, 3).Value

  Range(Cells(i, 1), Cells(i, 3)).Interior.Color = RGB(192, 192, 192)

End If
Next i

  ' Delete Blank Rows

    For j = Range("A1").End(xlDown).Row To 2 Step -1
    If Cells(j, 1).Interior.Color <> RGB(192, 192, 192) Then Cells(j, 1).EntireRow.Delete

Next j

End Sub

如果 ID 匹配，则在其他列中插入新行和总值

If ID's match insert new row and total values in other columns

excel

vba

insert

spreadsheet

subtotal