Простой VBA-скрипт для пометки транзакций на сумму более 4000 долларов, которые следуют шаблону

Question

Я пытаюсь написать простой скрипт, который сравнивает и помечает похожие транзакции (строки) и вставляет их внизу листа.Транзакции, которые должны быть помечены, должны соответствовать следующим критериям.

Сумма $ в транзакциях больше 4000 или меньше -4000 (столбец 11) Две сравниваемые транзакции имеют одинаковый номер детали (столбец 3) Две транзакции с одинаковыми суммами в долларах (между 90-110% друг от друга) и напротив знака числа

Sub checktrans()

Dim newLastRow, rowcount As Long
Dim row, row2, amountcol, partnumcolcol As Integer

amountcol = 16
partnumcol = 3
rowcount = 27307
newLastRow = 37309

For row = 1 To rowcount

    For row2 = 1 To rowcount

      If Cells(row, amountcol) > 4000 Or Cells(row, amountcol) < -4000 Then

        If row <> row2 Then

           If Cells(row, partnumcol) = Cells(row2, partnumcol) Then

                If Abs(Cells(row, amountcol)) > 0.9 * Abs(Cells(row2, amountcol)) And Abs(Cells(row, amountcol)) < 1.1 * Abs(Cells(row2, amountcol)) Then

                 If (Cells(row, amountcol) < 0 And Cells(row2, amountcol) > 0) Or (Cells(row, amountcol) > 0 And Cells(row2, amountcol) < 0) Then

                   ActiveSheet.Rows(row).Copy
                    ActiveSheet.Rows(newLastRow).PasteSpecial xlPasteAll
                    newLastRow = newLastRow + 1

                    ActiveSheet.Rows(row2).Copy
                    ActiveSheet.Rows(newLastRow).PasteSpecial xlPasteAll
                    newLastRow = newLastRow + 1

                 End If
                End If

           End If

        End If
     End If
    Next row2

Next row

End Sub

Я написал код выше, и он, кажется, работает для небольшого числа строк (ниже 500), но когда число строк превышает 27000,входит в бесконечный цикл, который продолжает вставлять новые строки на лист.Он также публикует каждую пару транзакций дважды, что, как я понимаю, является ошибкой в ​​логике, которую я тоже должен отработать.

PS Я гигантский нуб, когда дело доходит до этого, я не очень много программировал раньше, и сейчас я только учусь, чтобы сделать мою жизнь проще.

Answer 1

Первое, что вы можете сделать, это запустить второй цикл с того места, где находится первый цикл.Как For row2 = row + 1 to rowcount.Вы уже проверили предыдущие записи.Это также решит проблему с дубликатами, и вы можете удалить If row <> row2.

Во-вторых, это использовать Application.ScreenUpdating = False в начале макроса и Application.ScreenUpdating = True в конце.Это отключает обновление экрана во время работы макроса и может значительно повысить производительность.

В конце вы можете объединить все If в один, используя And, однако я не знаю,это улучшит производительность.