在合并循环中删除错误的行

情况：我想要通过基于第一列值（项目ID号）对行进行求和来合并数据。 如果身份证号码匹配，我希望将行添加在一起，删除重复的行。

我已经写了下面的代码，我遇到了两个问题：1.第一次运行代码时，总是有一些没有被合并的重复项2.如果我再次运行代码，它总结和删除行，即使它们是不重复。

任何帮助将非常感激。

Sub ConsolidateRows() Dim WB As Workbook Dim WS As Worksheet Dim iRow As Long Dim iCol As Long Dim LastRow As Long Dim LastCol As Long Dim duplicate As String Dim dupRow As Long Dim cell As Range Dim i As Integer 'set Set WB = Workbooks("Book1") Set WS = WB.Sheets("Data") LastRow = WS.UsedRange.Rows.Count LastCol = WS.UsedRange.Columns.Count 'Loop to consolidate, delete the duplicate rows iRow = 1 While WS.Cells(iRow, 1).Value <> "" duplicate = Cells(iRow, 1).Value iRow = iRow + 1 For Each cell In WS.Range("A1:A" & LastRow).Cells dupRow = cell.Row If cell.Value = duplicate And iRow <> dupRow Then For iCol = 3 To LastCol Cells(iRow, iCol) = Application.WorksheetFunction.Sum(Cells(iRow, iCol), Cells(dupRow, iCol)) Next iCol WS.Rows(dupRow).Delete End If Next cell Wend End Sub 

Answer 1

删除行时，请始终从底部开始，然后继续前进。

例如，如果列1-5的列A包含：

 Alpha Bravo Charlie Delta Foxtrot 

你删除第3行，你现在有

 Alpha Bravo Delta Foxtrot 

您的循环计数器（值3 ）在删除之前指向Charlie ，但现在指向Delta ，然后将计数器增加到4 ，并指向Foxtrot ，因此您从未评估是否需要删除Delta 。

尝试这个：

 'Loop to consolidate, delete the duplicate rows iRow = LastRow While WS.Cells(iRow, 1).Value <> "" duplicate = Cells(iRow, 1).Value iRow = iRow - 1 For Each cell In WS.Range("A1:A" & LastRow -1).Cells dupRow = cell.Row If cell.Value = duplicate And iRow <> dupRow Then For iCol = 3 To LastCol Cells(iRow, iCol) = Application.WorksheetFunction.Sum(Cells(iRow, iCol), Cells(dupRow, iCol)) Next iCol WS.Rows(dupRow).Delete LastRow = LastRow - 1 End If Next cell Wend 

^{*注：代码改变了我的头顶，你可能需要做一些小的额外的调整，让它倒退}

另外，请调查.Find() – 它会使您的代码运行速度明显快于finddups。