Question

我是一个泡菜:(

我有以下数据，任务是识别唯一记录并将它们合并为值。

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

OrgData http://im80.gulfup.com/uDNyW7.png

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

EndData http://im75.gulfup.com/PvkIWz.png

我尝试过使用帮助列，它是＆＃34;客户端ID＆＃34;和＆＃34;日期＆＃34;

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

然后我尝试将辅助列复制到临时表并删除重复项，然后对于每个剩余值，我使用辅助列值的autofilter，然后将列D的结果相加并将其写入新表。

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

但是考虑到我的工作表有超过60K +行，它需要永远。

我确信那里有更好的方法，但我们无法想到。

Answer 1

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

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

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

Answer 2

一种简单的方法是将两个单元格组合成F2类型

=A2 & D2

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

Answer 3

OP希望VBA，但也提到了＃34;我还能尝试什么？＃34;所以基于这可能允许其他可能性的借口，公式基础解决方案可能是：

处理副本。
添加一个列（比如A，其中=IF(OR(B1<>B2,D1<>D2),"*","")在A2中向下复制以适应（即~60k行）并在列表底部添加*。（希望这将涵盖以下情况：不同的日期彼此相邻但具有相同的客户端ID，但示例中未显示。）
将A和粘贴特殊值复制到顶部（可能会跳过，直到步骤6的一部分）。
现在应该有星号来标记要保留Item名称的行（以及需要总计的位置）。
在G2中并向下复制以适应：=IF(ISBLANK(A2),"",SUM(INDIRECT("E"&ROW()&":E"&ROW()+MATCH("~*",A3:A$65000,0)-1)))
选择，复制和粘贴特殊值，值位于顶部。
过滤以选择ColumnA中的(Blank)并删除所有可见的除标题。
删除过滤器。

多个小计应该更快批次，但如果经常重复，仍然可能不适合。但是，相应的步骤可以构建到子程序中，或者上面为宏记录。

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

3 个答案: