Если Loop и ряд Исключен

Question

UPDATE:

Ситуация: У меня есть данные, что я пытаюсь объединить суммированием строк на основе первого значения столбца (пункт идентификационный номер). Если совпадают идентификационные номера, я хочу, чтобы строки были добавлены вместе, а дублированные строки удалены.

Я написал следующий код, и я испытываю 2 проблемы: 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