匹配 80k 行的 excel 工作簿中的两列值，然后将名称写入新的 sheet 和第 3 列的相应值。还抓取最新日期

Question

我有一个 sheet 和 80k 行的工作簿，如下所示。同一个客户端可能在 sheet1.i 中出现 100 次，需要查找 ddindex 值“1”下的值和层值“2”下的值，如果这些条件匹配，则选择客户端名称并放入新的 sheet ( sheet2) 及其来自列数据大小的值。如果同一个客户端在 sheet1 中逐行使用上述条件再次出现，则在第二个 sheet（sheet2）中添加（将其与先前值相加）数据大小。并在秒 sheet 中获取同一客户端的最新创建日期和到期日期。知道如何使用 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

匹配 80k 行的 excel 工作簿中的两列值，然后将名称写入新的 sheet 和第 3 列的相应值。还抓取最新日期

match two column value in excel workbook of 80k rows then write name to new sheet and corresponding value from 3rd column. Also grab latest dates

excel

vba