Удаление дублирующих транзакций - VBA или функция

Question

Пример набора транзакций:

Обратите внимание на 3 показанные транзакции. Две транзакции, выделенные зеленым цветом, - это те, которые я хотел бы удалить или пометить (не имеет значения).

Используя VBA, код слишком неуклюжий. Код работает вечно, потому что

1. Я перебираю каждую транзакцию в столбце C, пока не найду отрицательный результат.
2. Установите столбец E в качестве цели абсолютного значения, если не ноль, иначе абсолютное значение D.
3. Определите диапазон для конкретной учетной записи, чтобы я мог начать цикл по ней, чтобы найти значение на шаге 2.
4. Если я нахожу значение, я удаляю обе строки (одну, содержащую отрицательный, и одну, которая не является отрицательной).

Мои извинения за не комментирование кода. Это еще не было сделано на 100%.

Sub ReversalScrub()

Dim AccountNumber As String
Dim TargetAmount As Double
Dim TargetRange As Range
Dim Transactions As Range
Dim Transaction As Variant
Dim DeletionCount As Integer

    Set RawTransactions = Worksheets("RawTransactions")

    With RawTransactions
            Set Transactions = .Range("C1", .Range("C2").End(xlDown))

    End With

    TransactionRow = 2

    Do Until TransactionRow = Transactions.Rows.Count

        If Range("C" & TransactionRow).Value < 0 Then

            If Range("C" & TransactionRow).Offset(0, 2).Value < 0 Then

                TargetAmount = Abs(Range("C" & TransactionRow).Offset(0, 2).Value)
            Else
                TargetAmount = Abs(Range("C" & TransactionRow).Offset(0, 1).Value)
            End If

                AccountNumber = Range("C" & TransactionRow).Offset(0, -2).Value

                Set TargetRange = GetAccountRange(AccountNumber, RawTransactions)

                CurrentRow = TargetRange.Row

                Do Until CurrentRow = TargetRange.Rows.Count - 1
                    If (TargetAmount = Range("E" & CurrentRow).Value Or TargetAmount = Range("D" & CurrentRow).Value) Then
                        Range("A" & CurrentRow).EntireRow.Delete
                        Range("C" & TransactionRow).EntireRow.Delete
                        CurrentRow = CurrentRow - 2
                        Exit Do

                    End If
                    CurrentRow = CurrentRow + 1
                Loop
        End If
        TransactionRow = TransactionRow + 1
    Loop

End Sub

Тогда я решил написать функцию, чтобы увидеть, будет ли она быстрее.

1. Столбец F: проверьте, является ли транзакция отрицательной. Если это так, создайте ключ, используя номер счета, abs(столбец D), abs(столбец E). =IF((C91<0),A91&ABS(D91)&ABS(E91))
2. Столбец G: Создайте номер ключевого счета, столбец D, столбец E. =A91&D91&E91
3. Столбец H: Проверьте, существует ли столбец F в G, используя Match . =IFERROR(MATCH(F91,$G$1:G91,0),FALSE)
4. Столбец I: Проверьте, соответствует ли фактическая строка ячейки столбцу H из шага. =IFERROR(MATCH(ROW(H91),H:H,0),FALSE)
5. Столбец J: Проверьте, является ли H или I числом (вывод MATCH ), если это так, они помечаются как отмены, и пользователь может удалить их. =IF(OR(ISNUMBER(H91),ISNUMBER(I91)),"Reversal",IF(C91=0,"Zero",""))

Проблема в том, что это тоже сбивает мой компьютер. Как я могу эффективно найти дубликаты и удалить их, не удаляя третий ряд?

Второй образец раствора:

Answer 1

Это похоже на работу с небольшим набором данных. Попробуйте и настройте по мере необходимости. Я помечаю ячейку F сообщением об отмене.

Это просматривает столбец C, пока не найдет пустую ячейку. Если у вас есть пустые ячейки, вам нужно настроить цикл «До».

Я пропускаю ячейки, которые были помечены ранее (не пустая ячейка F)

Обратите внимание, что только одна ячейка будет помечена как соответствующая.

Sub FlagReversals()

Dim MyExit As String
Dim PosLoc
Dim NegLoc
Dim NegAmt
Dim PosAmt

Range("C2").Select

  Do Until IsEmpty(ActiveCell)
    If ActiveCell.Value < 0 And IsEmpty(ActiveCell.Offset(0, 3).Value) Then
       NegLoc = ActiveCell.Address
       Acct = ActiveCell.Offset(0, -2)
       NegAmt = ActiveCell.Value
       PosAmt = Abs(ActiveCell.Value)
       MyExit = "False"
       Do Until MyExit = "True"
          If ActiveCell.Offset(-1, 0).Row > 1 Then
             ActiveCell.Offset(-1, 0).Select
          Else
             Range(NegLoc).Select
             ActiveCell.Offset(1, 0).Select
             MyExit = "True"
          End If
          If Acct = ActiveCell.Offset(0, -2) And IsEmpty(ActiveCell.Offset(0, 3).Value) And MyExit = "False" Then
             If PosAmt = ActiveCell.Value Then
               ' found the match (by account and value)
               ActiveCell.Offset(0, 3).Value = "Reversal from address " & NegLoc
               PosLoc = ActiveCell.Address
               Range(NegLoc).Select
               ActiveCell.Offset(0, 3).Value = "Reversal from address " & PosLoc
               MyExit = "True"
             End If
          End If
       Loop
    End If
  ActiveCell.Offset(1, 0).Select
  Loop

End Sub

Изменить: Очистить бесконечный цикл, когда не найдено совпадений.