合并重复项和总计列

我需要一些代码来find列B中的重复项，然后如果find和列I，J和L.然后删除重复的行，只留下1个实例。

我有一个button单击Sheet1，代码需要在Sheet4上运行。

我目前有这个代码，完成任务，但它只适用于活动工作表，我似乎无法使其工作的另一个工作表。

Private Sub CommandButton1_Click() Application.ScreenUpdating = False '### Excel wont update its screen while executing this macro. This is a huge performace boost Dim SumCols() '### declare a second empty array for our sum columns SumCols() = Array(9, 10, 12) '### the second array stores the columns which should be summed up '### the next line sets our range for searching dublicates. Starting at cell A2 and ending at the last used cell in column A Set searchrange = Range([b1], Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious)) For Each cell In searchrange '### now we start looping through each cell of our searchrange Set Search = searchrange.Find(cell, after:=cell, lookat:=xlWhole) '### searches for a dublicate. If no dub exists, it finds only itself Do While Search.Address <> cell.Address '### until we find our starting cell again, these rows are all dublicates For i = 0 To UBound(SumCols) '### loop through all columns for calculating the sum '### next line sums up the cell in our starting row and its counterpart in its dublicate row Cells(cell.Row, SumCols(i)) = CDbl(Cells(cell.Row, SumCols(i))) + CDbl(Cells(Search.Row, SumCols(i))) Next i '### go ahead to the next column Search.EntireRow.Delete '### we are finished with this row. Delete the whole row Set Search = searchrange.Find(cell, after:=cell) '### and search the next dublicate after our starting row Loop Next '### from here we start over with the next cell of our searchrange '### Note: This is a NEW unique value since we already deleted all old dublicates Application.ScreenUpdating = True '### re-enable our screen updating End Sub 

所有的帮助表示赞赏！

Answer 1

首先select表格，以便它成为ActiveSheet：

 Sheets("MergedData").Select 

或者最好参考使用With（未testing）：

 Option Explicit Private Sub CommandButton1_Click() Dim searchrange As Range, cell As Range, Search As Range Dim I As Integer Dim SumCols() Application.ScreenUpdating = False SumCols() = Array(9, 10, 12) With Sheets("MergedData") Set searchrange = .Range(.Range("b1"), .Columns(2).Find(what:="*", after:=.Range("b1"), searchdirection:=xlPrevious)) For Each cell In searchrange Set Search = searchrange.Find(cell, after:=cell, lookat:=xlWhole) Do While Search.Address <> cell.Address For I = 0 To UBound(SumCols) .Cells(cell.Row, SumCols(I)) = CDbl(.Cells(cell.Row, SumCols(I))) + CDbl(.Cells(Search.Row, SumCols(I))) Next I Search.EntireRow.Delete Set Search = searchrange.Find(cell, after:=cell) Loop Next End With Application.ScreenUpdating = True End Sub 

Answer 2

假设你想要在你的工作簿中的每个工作表上执行这个操作，你只需要在你的代码的其余部分包围另一个循环，然后指定它在你的范围内的工作表中。 对于你发布的代码，它看起来像这样：

 Option Explicit Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim SumCols() Dim ws As Worksheet SumCols() = Array(9, 10, 12) For Each ws In Worksheets Set searchrange = Range(ws.Range("B1"), ws.Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious)) For Each cell In searchrange Set Search = searchrange.Find(cell, after:=cell, lookat:=xlWhole) Do While Search.Address <> cell.Address For i = 0 To UBound(SumCols) '### next line sums up the cell in our starting row and its counterpart in its dublicate row Cells(cell.Row, SumCols(i)) = CDbl(Cells(cell.Row, SumCols(i))) + CDbl(Cells(Search.Row, SumCols(i))) Next i Search.EntireRow.Delete Set Search = searchrange.Find(cell, after:=cell) Loop Next cell Next ws Application.ScreenUpdating = True End Sub 

相关的变化是for each循环的额外变化

  Set searchrange = Range([b1], Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious)) 

至

  Set searchrange = Range(ws.Range("B1"), ws.Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))