Question

在包含约70万行的工作表上，我在列上显示了当前行ID所在的上一行的最后一个值

使用我的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

70万行约3秒。

Answer 2

如果您的工作表是这样，您可以尝试下面的代码在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

Answer 3

最好只调用一次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

优化VBA阵列而不是范围？

3 个答案: