Excel VBA Duplicate Checker - PullRequest
Новая
       7

Excel VBA Duplicate Checker

0 голосов
/ 05 ноября 2018

** Спасибо всем за указатели на то, как и раздел Code Review. Сегодня я переключился на получение и сравнение чисел, создавая массив для каждой группы чисел. Это работает в считанные секунды, а не минуты. **

У меня есть рабочий код, он отлично справляется со своей работой. Его цель - проверить и сообщить о наличии дублирующих номеров ссуд, сравнив лист ReadyForExport (обычно около 60 строк) с листом PastLoanLog (в настоящее время около 1300 строк) один за другим.

Вопрос: есть идеи, как закодировать этот лучше ? Запуск занимает несколько минут, но если есть способ заставить его работать быстрее, это то, что я ищу. Вот код: 

Sub DupTest2()

'This runs through the RFE list, checks the 2nd mortgage numbers
'and reviews against the PastLoanLog spreadsheet

MsgBox ("This may take a minute")

OpenSheets 'Opens worksheets needed to run the program

Dim TestDpaNum As String
Dim PastDpaNum As String
Dim lRow As Integer
Dim DupNum As Integer
Dim h As Integer
Dim i As Integer
Dim lrowHFE As Integer

Sheets("ReadyForExport").Select
Range("G2").Select
lrowHFE = Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print "Ready For Export LR " & lrowHFE


'Locate Last Row In PastLoanLog Data
'**********************************
Sheets("PastLoanLog").Select
Range("G2").Select
lRow = Cells(Rows.Count, 1).End(xlUp).Row


Sheets("ReadyForExport").Select
Range("G2").Select

    For h = 2 To lrowHFE

    'Finds the first loan number to check against the old data

    TestDpaNum = ActiveCell.Value

    Sheets("PastLoanLog").Select

    Range("G2").Select

            For i = 1 To lRow

            'Selects current cell to compare with cell from RFE sheet
            PastDpaNum = ActiveCell.Value

                If PastDpaNum = TestDpaNum Then
                    DupNum = DupNum + 1
                    Debug.Print "Duplicate Found" & TestDpaNum
                    Sheets("ErrorSheet").Range(DupNum, 6).Value = TestDpaNum
                    ActiveCell.Offset(1, 0).Select

                Else
                    ActiveCell.Offset(1, 0).Select

                End If

            Next

    Sheets("ReadyForExport").Select
    ActiveCell.Offset(1, 0).Select
    Debug.Print "CurrentRow=" & h

Next

'Sends the info to the Dashboard

Debug.Print "Dups = " & DupNum
Sheets("Dashboard").Select
Range("P16").Select
ActiveCell.Value = DupNum
ActiveCell.Offset(1, 0).Value = Now()
CloseSheets

End Sub
...