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

我有点为难：(

我有下面的数据，任务是识别唯一的记录，并将它们组合起来求和

让我解释一下，以下是数据：

因此，我需要得到的最终结果是每个客户每次访问的数据，以及作为第一项保留的价格和项目名称的总和：

我试过使用一个helper列，它是“Client ID”和“Date”的组合

然后，我尝试将helper列复制到临时工作表中并删除重复项，然后对剩余的每个值使用autofilter按helper列值进行筛选，然后将D列的结果相加，并将其写入新工作表

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

但考虑到我的工作表有超过60K行，这需要花费很长时间

---

我确信有更好的方法，但就是想不出任何方法。

一个简单的方法是将两个细胞组合成F2类型

=A2 & D2

---

然后对E列进行排序，然后对数据进行小计，在F列中每次更改时对D列求和。

OP想要VBA，但也提到了“我还可以尝试什么”，因此，基于这可能会考虑其他可能性的理由，公式基础解决方案可能是：

复印一份

在A2中添加一列（例如a，带有

=IF（或（B1B2，D1D2），“*”，”）

，并将

*

添加到列表底部（希望这将涵盖不同的日期相邻但具有相同客户ID的情况，尽管示例中未显示）

复制并在顶部粘贴特殊值（可能会跳过，直到步骤6的一部分）

现在应该有星号来标记要保留

项目

名称的行（以及需要总计的行）

在G2中并向下复制以适应：

=IF（为空白（A2），“”，SUM（间接（“E”&ROW（）&“：E”&ROW（）+匹配（“~*”，A3:A$65000,0）-1））

在顶部选择、复制和粘贴特殊值

筛选以选择列A中的

（空白）

，并删除除标题外的所有可见内容

卸下滤清器

---

应该比多个小计快得多，但如果经常重复，可能仍然不适合。但是，相应的步骤可以内置到子例程中，或者为宏记录上述步骤。

下面是一个VBA解决方案，使用用户定义的对象：cVisit，它具有ID、名称、日期、价格和项目五个属性

编辑：我运行了一些计时测试，根据源数据中重复项的分布情况，它在我的机器上运行5到15秒，数据源为60000行

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

---

---

然后，在常规模块中：

---

选项显式
每日访问次数（次）
尺寸wsSrc作为工作表，vSrc作为变量，rSrc作为范围
Dim vRes（）作为变量，wsRes作为工作表，rRes作为范围
Dim cV作为cVisit，Colvisions作为集合
我想我会坚持多久
像线一样模糊
设置wsSrc=工作表（“表1”）
设置wsRes=工作表（“表1”）
设置rRes=wsRes.范围（“H1”）
'将源数据读入数组，因为迭代VBA数组要快得多
“而不是工作表
与wsSrc
设置rSrc=.Range（“a1”，.Cells（.Rows.Count，“A”）.End（xlUp））.Resize（columnsize:=5）
vSrc=rSrc
以
'将所有访问收集到键入客户ID和日期的集合中
Set colvisions=新集合
出错时继续下一步
对于I=2至UBound（vSrc，1）
设置cV=新cVisit
带cV
.ID=vSrc（I，1）
.Name=vSrc（I，2）
.DT=vSrc（I，3）
.Price=vSrc（I，4）
.项目=vSrc（I，5）
sKey=CStr（.ID&“|”和.DT）
Colvisions.添加简历，sKey
'如果此ID和日期的记录已存在，则添加
'将价格添加到现有记录。否则将添加新记录
如果错误编号=457，则
与科利（斯凯）
.Price=.Price+cV.Price
以
如果错误号为0，则停止
如果结束
呃，明白了
以
接下来我
错误转到0
'以最大限度地减少大型数据库出现内存不足错误的可能性
擦除vSrc
vSrc=rSrc.行（1）
'将集合写入“结果”数组
'然后将其写入工作表并格式化
ReDim VRE（0到5次访问。计数+1，1到5）
对于I=1至UBound（vRes，2）
vRes（0，I）=vSrc（1，I）
接下来我
对于I=1到1，计数
（一）
vRes（I，1）=.ID
vRes（I，2）=.名称
vRes（I，3）=.DT
vRes（I，4）=价格
vRes（I，5）=项目
以
接下来我
使用rRes.调整大小（UBound（vRes），UBound（vRes，2））
.全部清除
.Value=vRes
带.行（1）
.Font.Bold=True
.HorizontalAlignment=xlCenter
以
.Columns（3）.NumberFormat=“d/mm/yyyy”
.Columns（4）.NumberFormat=“$#，###0.00”
.全自动装配
以
端接头

---

---

根据需要调整源和结果工作表，并运行结果范围的第一个单元格。

@pnuts实际上VBA在这里是必须的。在按要求组合数据后，VBA中有很多工作要做。有什么想法吗？在这种情况下，小计如何准确地工作以提供我所需的输出数据？@pnuts感谢s建议，但目前运行小计需要50多分钟。我还可以尝试什么？看起来很鼓舞人心…让我试试。它在15秒内确实有效。哇，你在课堂模块上多走了一步。谢谢，你让我这周过得很愉快：）@船长ABC我很高兴它能很好地为您工作。我发现，经常使用类模块可以使编程变得更容易，无论是在最初还是以后需要维护/更改时。使用命名属性，我更容易准确地看到代码在做什么。

=A2 & D2

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