Как использовать функцию FindFirst для сравнения 2 записей в памяти? - PullRequest
Новая
       46

Как использовать функцию FindFirst для сравнения 2 записей в памяти?

0 голосов
/ 01 февраля 2019

Я хочу перебрать столбец A и проверить, существует ли какое-либо из значений в столбце B. В настоящее время я использую функцию .Find, однако, когда я начал работать с большими наборами строк (> 60 000), он начал приниматьдолгое время для запуска кода.

Я думал, что смогу создать 2 набора записей в памяти каждого столбца и сравнить их, используя .FindFirst, но не могу заставить его работать.Я думаю, это потому, что я не использую никаких соединений «ADO / DAO», поскольку мои данные находятся в самой рабочей книге.

Есть ли способ быстро найти совпадение в столбце B для каждого из значений столбцаA?

Я пытался изменить код на .FindFirst и использовать наборы записей, но он продолжает говорить «Объект не поддерживает свойство и т. Д.». 

For Each cel In rngRD.Cells

    With ThisWorkbook.Sheets("RawData").Range("A1:A" & Last_Row_DB)
        .Cells(1, 1).Activate
        Set CRef = .Find(What:=cel, _
                    After:=ActiveCell, _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False, _
                    SearchFormat:=False)
        'If cannot be found then
        If CRef Is Nothing Then
            'Do Something
        Else
            Set CRef = .FindNext(CRef)
        End If

    End With

Next cel

1 Ответ

0 голосов
/ 03 февраля 2019

Я не мог заставить его работать со словарями, но нашел другой способ сделать то, что мне нужно, и время вычисления очень быстро для числа строк> 60 000. Лучшее, что я мог сделать на данный момент! 

Sub compareData()

Dim ListA As Range
Dim ListB As Range
Dim c As Range

'Create recordset to hold values to copy
Set rs = New Recordset
    With rs
        .Fields.Append "ID", adVarChar, 1000, adFldIsNullable
        .Fields.Append "Sector", adVarChar, 1000, adFldIsNullable
        .Fields.Append "Category", adVarChar, 1000, adFldIsNullable
        .Fields.Append "Description", adVarChar, 1000, adFldIsNullable
        .Fields.Append "DayNum", adVarChar, 1000, adFldIsNullable
        .Fields.Append "Site", adVarChar, 1000, adFldIsNullable
        .Fields.Append "Prod", adVarChar, 1000, adFldIsNullable
        .Fields.Append "SU", adInteger, , adFldMayBeNull
        .Fields.Append "BaseUnit", adInteger, , adFldMayBeNull
        .Open
    End With

'Define 2 lists to compare (ID's)
ListARange = Sheets("DATA").Cells(Rows.Count, "A").End(xlUp).Row 'Find the last row with data on column A
ListBRange = Sheets("RAW DATA").Cells(Rows.Count, "A").End(xlUp).Row 'Find the last row with data on column B

Set ListA = Sheets("DATA").Range("A2:A" & ListARange) 'Set your range only until the last row with data
Set ListB = Sheets("RAW DATA").Range("A2:A" & ListBRange)

'Check if ID already exists in the list, if not, add to recordSet
For Each c In ListB
    If Application.CountIf(ListA, c) = 0 Then
        rs.AddNew
        rs!ID = c
        rs!Sector = c.Offset(0, 1)
        rs!Category = c.Offset(0, 2)
        rs!Description = c.Offset(0, 3)
        rs!DayNum = c.Offset(0, 4)
        rs!Site = c.Offset(0, 5)
        rs!Prod = c.Offset(0, 6)
        rs!SU = c.Offset(0, 7)
        rs!BaseUnit = c.Offset(0, 8)
        rs.Update
    End If
Next c
...