匹配 80k 行的 excel 工作簿中的兩列值，然后將名稱寫入新工作表和第三列中的相應值。 還可以獲取最新日期

Question

我有一張工作簿和 80k 行，如下所示。 同一個客戶可能會在 sheet1 中出現 100 次。我需要在 ddindex 值“1”和層值“2”下查找值，如果這些條件匹配，則選擇客戶名稱並將其值放入新表 (sheet2)從列數據大小。 如果同一客戶端再次使用上述條件在 sheet1 中逐行進行，則在第二張表（ sheet2 ）中添加（將其與先前值相加）數據大小。 並在第二張表中獲取同一客戶的最新創建日期和到期日期。 知道如何使用 VBA 來實現這一點嗎？

到目前為止，我提出了以下代碼

Option Explicit
Sub find()
    Dim i As Long
    Dim sheets As Variant
    Dim sheet As Variant
       
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
            
    Set ws = ThisWorkbook.sheets("Sheet2")
    
    For i = 2 To ActiveSheet.sheets("sheet1").Range("A2").End(xlDown).Row
             If Cells(i, 4).Value = 1 And Cells(i, 6).Value = 2 Then
                  ws.Range(1 & i).Value = Cells(i, 1).Value
                  ws.Range("A" & i).Value = Cells(i, 1).Value
              End If
    Next
             
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.ScreenUpdating = True
Application.EnableEvents = True


End Sub

Answer 1

嘗試這樣的事情：

Sub Summarize()
    Dim i As Long, ws1 As Worksheet, ws2 As Worksheet, data, m, client
    Dim dict As Object, dataOut, rw As Long
    
    Set dict = CreateObject("scripting.dictionary") 'for tracking unique client id's
    
    Set ws1 = ThisWorkbook.sheets("Sheet1")
    Set ws2 = ThisWorkbook.sheets("Sheet2")
    
    data = ws1.Range("A2:F" & ws1.Cells(Rows.Count, 1).End(xlUp).Row).Value 'data to array
    ReDim dataOut(1 To UBound(data, 1), 1 To UBound(data, 2))  'size output array
    
    rw = 0
    For i = 1 To UBound(data, 1)                       'loop over rows in the array
        If data(i, 5) = 1 And data(i, 6) = 2 Then      'processing this row?
            client = data(i, 1)
            
            If Not dict.exists(client) Then   'first time for this client?
                rw = rw + 1                   'increment "row" counter
                dict.Add client, rw           'store position in dictionary
                dataOut(rw, 1) = client       'add the client id
            End If
            rw = dict(client)                 'find the array "row" to update
            If data(i, 2) > dataOut(rw, 2) Then
                dataOut(rw, 2) = data(i, 2)
                dataOut(rw, 3) = data(i, 3)
            End If
            dataOut(rw, 4) = dataOut(rw, 4) + data(i, 4)
            dataOut(rw, 5) = data(i, 5)
            dataOut(rw, 6) = data(i, 6)
        End If
    Next
    
    'drop the summarized data on the worksheet
    If rw > 0 Then ws2.Range("A2").Resize(rw, UBound(data, 2)).Value = dataOut
    
End Sub