使用在 Excel 中同一工作表中放置的新数据来更新具有唯一 ID 的前一行数据

Question

这更多的是出于优化目的，因为代码当前基于我的工作流程运行，但当有数千行需要处理时，可能需要一段时间。

本质上，我当前的工作流程涉及将每月数据附加到包含客户名称的工作表中。每个客户端都与一个唯一的 ID 绑定。当然，客户名称会随着时间的推移而发生变化，并且当发生这种情况时，链接到此工作表的数据透视表会变得混乱。

我的解决方案是根据客户的唯一 ID 对工作表进行排序，然后根据行的日期（从最新到最旧）进行排序。 然后，运行一个宏，将向下复制最上面的数据，因为最上面的数据将是客户端的最新名称。

我可以对此代码做任何进一步的优化，以使其在更大的数据集上运行得更快吗？当它处理超过 100K 行时，它开始嘎嘎作响。

'A code to disable screenupdates, calculations, etc already runs before this code.
'ColID = Column that contains the Unique ID. Ex: Column S.
'ColRangeStart & ColRangeEnd select which columns from the top are being copied. Ex: Column T:V
For i = 3 To lrow - 1 Step 1
    With ActiveSheet
        If .Range(ColID & i).Value <> "" Then
            IDToFind = .Range(ColID & i).Value
            lastFoundRow = .Columns(ColID).Find(What:=IDToFind, Lookat:=xlWhole, SearchDirection:=xlPrevious).Row
            
            If .Range(ColID & i).Row = lastFoundRow Then
                GoTo SkipLoop
            Else
                If WorksheetFunction.CountA(.Range(ColRangeStart & i & ":" & ColRangeEnd & i)) <> 0 Then
                    .Range(ColRangeStart & i & ":" & ColRangeEnd & i).Copy .Range(ColRangeStart & i & ":" & ColRangeEnd & lastFoundRow)
                    i = lastFoundRow
                End If
            End If
        Else
            .Range(ColID & i & ":" & ColRangeEnd & i).Copy .Range(ColID & i + 1 & ":" & ColRangeEnd & i + 1)
            GoTo SkipLoop
        End If
    End With
SkipLoop:
    DoEvents
    ProgressBar.lblCount.Caption = "Processing " & i & " out of " & lrow - 1 'Got a GUI Progress bar for this code
    ShowProgress (i)
Next

Answer 1

这样的事情会快得多：

Sub Tester()

    Dim rngId As Range, arrId, rngInfo As Range, arrInfo, currId, idRow As Long, id
    Dim r As Long, c As Long, ubInfoCols As Long, lrow As Long, ws As Worksheet
    
    Set ws = ActiveSheet
    lrow = ws.Cells(Rows.count, "A").End(xlUp).Row
    
    Set rngId = ws.Range("S3:S" & lrow)
    arrId = rngId.Value  'read all id's
    
    Set rngInfo = ws.Range("T3:V" & lrow)
    arrInfo = rngInfo.Value 'read all info
    ubInfoCols = UBound(arrInfo, 2) '# of cols
    
    currId = Chr(0) ' any unlikely value
    For r = 1 To UBound(arrId, 1)
        id = arrId(r, 1)
        If Len(id) > 0 Then      'any id present?
            If id <> currId Then 'new Id?
                currId = id 'set to current id
                idRow = r   'remember start row
            Else
                'same id: copy info down
                For c = 1 To ubInfoCols
                    arrInfo(r, c) = arrInfo(idRow, c)
                Next c
            End If
        End If
    Next r
    
    rngInfo.Value = arrInfo 'update info column data
            
End Sub