我正在尝试整合共享多个属性（例如订单号和产品号）的数据行。例如：订单12345有4行数据，所有数据都具有相同的产品编号，但每行都有唯一的收入金额。
我希望得到一个最终结果，其中所有4行合并为1行，其中收入金额来自4条原始行。此外，每一行都有一个开始和结束日期。我需要最后的合并行将最早的（MIN）开始日期和最后一个（MAX）结束日期作为合并行中的最终结果。
我要合并的目标行在数据中并不总是连续的，因此我认为字典是他们要去的方式（其中一个唯一的ID（用于标识需要合并的行）是我的“关键” ）。我在这里发现了一个类似的问题，并使用该答案中的代码到达我现在的位置。
我有一个“唯一ID”，用于确定哪些行需要合并在一起（如果ID相同，则需要合并行）。唯一ID是4列的串联（订单号，产品，合同名称和州）。
我目前的代码是：
Dim oRange As Range
Dim oTarget As Range
Dim oRow As Range
Dim oRowAmend As Range
Dim oDic As Scripting.Dictionary
Dim sIndex As String
Dim vKey As Variant
Dim vItem As Variant
Dim LastRow As Long
Worksheets("ODD Data").Activate
LastRow = Worksheets("ODD Data").Range("A" & Rows.Count).End(xlUp).Row
'Define the source range
Set oRange = Sheets("ODD Data").Range("A2:CE" & LastRow)
'Define where the updated data will be printed.
Set oTarget = Sheets("Consolidated ODD Data").Range("A2:CE2")
Set oDic = New Scripting.Dictionary
For Each oRow In oRange.Rows
'Define Indexes (what is checked for duplicates)
sIndex = oRow.Cells(82) 'Column 82 is my unique ID column
'If the index exists, sum the values
If oDic.Exists(sIndex) Then
Set oRowAmend = oRow
oRowAmend.Cells(36).Value = oRow.Cells(36).Value + oRowAmend.Cells(36).Value 'Column 36 is the column which has the revenue amount I wish to sum
oDic.Remove (sIndex)
oDic.Add sIndex, oRowAmend
'If does not exist, only store their values
Else
oDic.Add sIndex, oRow
End If
Next oRow
For Each vKey In oDic
vItem = oDic.Item(vKey)
oTarget = vItem
'Points oTarget for next row
Set oTarget = oTarget.Offset(1, 0)
Next vKey
End Sub
目前代码运行时没有错误，我将预期的行数输出到新的“Consolidated ODD Data”表。但是AJ列（36）并没有求和。似乎无论AJ列中的值是什么，最后一行的合并都只是加倍（不会添加到需要合并的其他行）。这不仅发生在输出表上，而且发生在原始数据集上（我不想要）。
我不知道如何将MIN / MAX功能应用于我的开始和结束日期。对此（或任何部分）的任何帮助都非常感谢。开始日期在列O中，结束日期在列P中。所有其他列在我合并的行之间是相同的。
我想知道我是否需要将数组作为字典中的项目故事？我是新手，有点过头了！
非常感谢提前！
答案 0 :(得分：2)
从Sheet1开始A1考虑此数据：
| Row | Key | Order | Product | Contract | State | Value | Start | End |
|-----|-----------------|-------|---------|----------|-------|-------|----------|----------|
| 1 | aaa|123|foo|bar | aaa | 123 | foo | bar | 11 | 27-11-17 | 08-01-18 |
| 2 | bbb|456|foo|bar | bbb | 456 | foo | bar | 11 | 22-11-17 | 23-12-17 |
| 3 | aaa|123|foo|bar | aaa | 123 | foo | bar | 10 | 30-11-17 | 05-01-18 |
| 4 | bbb|456|foo|bar | bbb | 456 | foo | bar | 13 | 03-12-17 | 08-01-18 |
| 5 | aaa|456|foo|bar | aaa | 456 | foo | bar | 27 | 04-12-17 | 24-12-17 |
| 6 | bbb|123|foo|bar | bbb | 123 | foo | bar | 6 | 12-12-17 | 26-12-17 |
| 7 | bbb|123|foo|bar | bbb | 123 | foo | bar | 9 | 10-12-17 | 30-12-17 |
| 8 | bbb|456|foo|bar | bbb | 456 | foo | bar | 11 | 04-12-17 | 06-01-18 |
| 9 | bbb|456|foo|bar | bbb | 456 | foo | bar | 24 | 28-11-17 | 23-12-17 |
| 10 | bbb|456|foo|bar | bbb | 456 | foo | bar | 27 | 26-11-17 | 06-01-18 |
| 11 | aaa|123|foo|bar | aaa | 123 | foo | bar | 3 | 27-11-17 | 07-01-18 |
| 12 | aaa|123|foo|bar | aaa | 123 | foo | bar | 1 | 02-12-17 | 24-12-17 |
| 13 | bbb|456|foo|bar | bbb | 456 | foo | bar | 26 | 01-12-17 | 03-01-18 |
| 14 | aaa|123|foo|bar | aaa | 123 | foo | bar | 26 | 05-12-17 | 31-12-17 |
| 15 | aaa|123|foo|bar | aaa | 123 | foo | bar | 24 | 08-12-17 | 21-12-17 |
Key的公式为：
=C2&"|"&D2&"|"&E2&"|"&F2
建议您（根据@RonRosenfeld）使用Class作为字典值，例如Class1（只需在VB编辑器中创建一个新类）然后输入：
Option Explicit
Public ConsolidatedRevenue As Double
Public FirstDate As Date
Public LastDate As Date
然后你可以使用这样的代码（使用intellisense支持）：
Dim obj As Class1
Set obj = New Class1
obj.ConsolidatedRevenue = 99
obj.ConsolidatedRevenue = obj.ConsolidatedRevenue + 99
因此，以下代码将：
Class1 代码：
Option Explicit
Sub Consolidate()
Dim ws As Worksheet
Dim rngData As Range
Dim objDic As Object
Dim lngCounter As Long
Dim varKey As Variant
Dim dblRevenue As Double
Dim dtStart As Date
Dim dtEnd As Date
Dim objData As Class1
Set ws = ThisWorkbook.Worksheets("Sheet1") '<-- change to your worksheet
Set rngData = ws.Range("A2:I16") '<-- change to your range with last row etc
Set objDic = CreateObject("Scripting.Dictionary") '<-- late bound reference to dictionary
For lngCounter = 1 To rngData.Rows.Count
varKey = rngData.Cells(lngCounter, 2).Value '<-- the key
dblRevenue = CDbl(rngData.Cells(lngCounter, 7).Value) '<-- the revenue
dtStart = CDate(rngData.Cells(lngCounter, 8).Value) '<-- the start date on row
dtEnd = CDate(rngData.Cells(lngCounter, 9).Value) '<-- the end date on row
' test for key in dictionary
If objDic.Exists(varKey) Then
' get existing data packet
Set objData = objDic(varKey)
' increment revenue
objData.ConsolidatedRevenue = objData.ConsolidatedRevenue + CDbl(rngData.Cells(lngCounter, 7))
' update first date if earlier
If dtStart < objData.FirstDate Then
objData.FirstDate = dtStart
End If
' update last date if later
If dtEnd > objData.LastDate Then
objData.LastDate = dtEnd
End If
Else
' create a new data packet
Set objData = New Class1
' set properties for new item
objData.ConsolidatedRevenue = dblRevenue
objData.FirstDate = dtStart
objData.LastDate = dtEnd
' store new data packet in dictionary
objDic.Add varKey, objData
End If
Next lngCounter
' test dictionary
For Each varKey In objDic.Keys
' output could go to another sheet instead of immediate window...
Debug.Print "Key: " & varKey
Debug.Print "Revenue: " & objDic(varKey).ConsolidatedRevenue
Debug.Print "First Date: " & objDic(varKey).FirstDate
Debug.Print "End Date: " & objDic(varKey).LastDate
Next varKey
End Sub
输出结果为：
Key: aaa|123|foo|bar
Revenue: 75
First Date: 27-Nov-17
End Date: 08-Jan-18
Key: bbb|456|foo|bar
Revenue: 112
First Date: 22-Nov-17
End Date: 08-Jan-18
Key: aaa|456|foo|bar
Revenue: 27
First Date: 04-Dec-17
End Date: 24-Dec-17
Key: bbb|123|foo|bar
Revenue: 15
First Date: 10-Dec-17
End Date: 30-Dec-17
您应该能够将其调整到您的数据集。要对日期进行最小/最大测试，建议的代码只在数据包中存储的当前日期（例如<属性）和行中的日期之间使用>和Class1正在处理中：
' update first date if earlier
If dtStart < objData.FirstDate Then
objData.FirstDate = dtStart
End If
' update last date if later
If dtEnd > objData.LastDate Then
objData.LastDate = dtEnd
End If
HTH
根据仅打印关键日期和收入的评论问题 - 您可以在课程中添加额外字段：
Option Explicit
Public ConsolidatedRevenue As Double
Public FirstDate As Date
Public LastDate As Date
Public Order As String
Public Product As String
Public Contract As String
Public State As String
'... etc
然后在主循环中，获取那些附加值，例如
' ... (Dim them all first e.g. Dim strOrder As String etc)
strOrder = rngData.Cells(lngCounter, 3).Value
strProduct = rngData.Cells(lngCounter, 4).Value
strContract = rngData.Cells(lngCounter, 5).Value
strState = rngData.Cells(lngCounter, 6).Value
' ...
然后您可以将它们添加到Class1：
' ...
objData.Order = strOrder
objData.Product = strProduct
objData.Contract = strContract
objData.State = strState
' ... etc
然后当你循环字典时，你可以输出它们，例如
Dim wsOutput As Worksheet
Set wsOutput = ThisWorkbook.Worksheets("Output") '<-- change to your output sheet
' loop the dictionary
Dim lng As Long
For lng = 0 To objDic.Count - 1
' ... instead of Debug.Print output to sheet with wsOutput.Cells(x, y).Value = foo
Set objData = objDic.Items()(lng)
wsOutput.Cells(lng + 1, 1).Value = objData.Order
wsOutput.Cells(lng + 1, 2).Value = objData.Product
wsOutput.Cells(lng + 1, 3).Value = objData.Contract
wsOutput.Cells(lng + 1, 4).Value = objData.State
wsOutput.Cells(lng + 1, 5).Value = objData.FirstDate
wsOutput.Cells(lng + 1, 6).Value = objData.LastDate
wsOutput.Cells(lng + 1, 7).Value = objData.ConsolidatedRevenue
' ... etc
Next lng