Оптимизировать массив VBA вместо диапазона?

Question

На листе, содержащем около 700К строк, я отображаю в столбце последнее значение в последней строке, где находится идентификатор текущей строки

С моим кодом VBA это занимает несколько часов Как я могу оптимизировать это? кто-то совет изменить мой код при использовании Ubound, но слишком сложный для меня ... :(

Вы можете мне помочь?

Sub Seekvba()
    Dim C As Range, where As Range, whatt As String
    Dim i As Long

    Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With


    For i = 2 To LastRow

        On Error Resume Next
        whatt = Range("O" + CStr(i)).Value
        Set C = Range("O1:O" + CStr(i - 1))
        Set where = C.Find(what:=whatt, after:=C(1), searchdirection:=xlPrevious, lookat:=xlWhole)
        Cells(i, "S").Value = Mid(where.Address(0, 0), 2)
        i = i + 1
        Next i



    End Sub

Answer 1

Один проход без обратного отслеживания:

Sub Tester()

    Dim dataIn, dataOut(), dict, i, rng As Range, v, t

    Set dict = CreateObject("scripting.dictionary")

    Set rng = Range("O2:O700000")

    'set up some test data
    With rng
        .Formula = "=""Sample_"" & ROUND(RAND()*10,0)"
        .Value = .Value
    End With

    t = Timer

    dataIn = rng.Value
    ReDim dataOut(1 To UBound(dataIn, 1), 1 To 1)

    For i = LBound(dataIn, 1) To UBound(dataIn, 1)
        v = dataIn(i, 1)
        If Not dict.exists(v) Then
            dict.Add v, i
        Else
            dataOut(i, 1) = dict(v) + 1 'adjust for Row start=2
            dict(v) = i 'remember this next row
        End If
    Next i

    rng.Offset(0, 4).Value = dataOut

    Debug.Print Timer - t

End Sub

Около 3 секунд для строк из 700 КБ.

Answer 2

Оптимально должен быть только один вызов в Excel, чтобы получить данные, и один, чтобы установить все результаты сразу:

Dim a, lastRow As Long, i As Long, j As Long
LastRow = Cells(Rows.Count, "O").End(xlUp).Row
a = Range("O1:O" + LastRow)

For i = UBound(a) To 2 Step -1
    For j = i - 1 To 1 Step -1
        If a(i, 1) = a(j, 1) Then
            a(i, 1) = j
            j = -1
            Exit For
        End If
    Next
    If j >= 0 Then a(i, 1) = Empty
Next

a(1, 1) = Empty
Range("S1:S" + LastRow) = a

Answer 3

Если ваш рабочий лист выглядит следующим образом, вы можете попробовать следующий код, чтобы получить вывод в столбце S, Array - лучшее решение при работе с тысячами строк.

Sub arraySearch()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("DATA") 'Name of your worksheet

Dim myData() As String 'Data Array Declaration
ReDim myData(1 To sh.Range("O" & Rows.Count).End(xlUp).Row) 'Declare size of the array

Dim result() As String 'Result Array Declaration
ReDim result(1 To sh.Range("O" & Rows.Count).End(xlUp).Row) 'Declare size of the array

'Transfer worksheet data to to myData Array
For a = 2 To sh.Range("O" & Rows.Count).End(xlUp).Row
    myData(a) = sh.Range("O" & a).Value
Next a

'Trying to convert your code, based on my understanding
'if the current row value is found from the previous row, that row number
'should be placed to column S
Dim whatt As String
For a = 2 To UBound(myData)
    whatt = myData(a)
    For b = a - 1 To 1 Step -1
        If whatt = myData(b) Then
            result(a) = b
            Exit For
        End If
    Next b
Next a

'Return the result value to column S
For a = 2 To UBound(result)
    sh.Range("S" & a).Value = result(a)
Next a

End Sub