Question

更新：

情况：我有一些数据，我试图通过根据第一列值（项目ID号）对行进行求和来合并。如果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

您不应该以这种方式删除行，因为您循环的范围将开始更改而不是指向所需的单元格。最快的修复（没有完全重构逻辑）是添加一个包含要删除的行的变量，然后将其全部删除。我最喜欢的方法是使用逗号作为分隔符的字符串（比使用数组更容易）

Dim rowsToDelete As String

For Each cell In WS.Range("A2:A" & LastRow).Cells
    jRow = cell.Row
       If cell.Value = "Desired Value" Then
           'Do Something
           rowsToDelete = rowsToDelete &  jRow & ","
       End If
Next cell
If Len(rowstoDelete) > 1 Then rowstoDelete = Left(rowsToDelete,Len(rowstoDelete) - 1)

If Len(rowstoDelete) > 0 then
     For i = UBound(Split(rowstoDelete,",")) to 0 Step -1
          WS.Rows(Split(rowstoDelete,",")(i)).Delete
     Next i
End If

如果循环和行已删除

1 个答案: