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

时间:2015-06-29 19:16:39

标签: excel excel-vba insert spreadsheet subtotal vba

我的电子表格大约有19列,行数总是在变化。列A包含“项目ID”,列N包含“已售出的项目数”,列O包含“项目数”。我正在尝试创建一个宏,每次A列中的“项目ID”更改时插入一行,并总计“已售出的项目数”以及“项目数”。如果可能的话,我还想将“Item ID”复制到这个新行中。如果有人能帮助我,我将非常感激。

更新:请参阅下面的电子表格示例截图(我试图发布图片,但因为我是新手,我想我还没有这种级别的访问权限。)

电子表格现在的样子:

example1

我希望电子表格能够在运行宏之后看到:

example2

2 个答案:

答案 0 :(得分:0)

最适合您的选择是数据小计。这是最耗时的。

<强>之前:

before

1。 小计位于大纲组中:

subtotal

2。详情:

subtotal_details

<强>后:

after

答案 1 :(得分:0)

ZygD,感谢您的帮助。我真的在寻找一个宏,因为这只是大约7个宏的一个,它将被绑定到一个按钮解决方案,供其他没有时间/知识来对这些行进行小计的人。

我想出了一个将电子表格复制到临时表的宏。在该临时表中,每次ID更改时,它都会添加一个灰色行,并对上述2个列进行小计...同时将所有其他信息复制下来。但是,这导致Excel冻结一段时间......所以我删除了除了我需要的所有列,小计,&amp;删除除灰色(小​​计)之外的所有行。这是我提出的宏(如果其他人正在寻找类似的东西):

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