Arrays 在VBA中使用字典将行与Sum和Max/Min合并到特定列

我正在尝试合并共享多个属性（例如订单号和产品号）的数据行。例如：订单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

目前代码运行没有错误，我得到了新的“合并奇数数据”表上输出的预期行数。然而，列AJ（36）不是求和。似乎AJ列中最后一行要合并的值只是增加了一倍（而不是添加到需要合并的其他行）。这不仅发生在输出表上，而且也发生在原始数据集上（我不想要）

我不知道如何将最小/最大功能应用于我的开始日期和结束日期。在此（或任何部分）上的任何帮助都将不胜感激。开始日期在第O列，结束日期在第P列。在我合并的行之间，所有其他列都是相同的

我想知道我是否需要将数组作为字典中的一项来编写故事？我是新来的，有点不知所措

---

非常感谢

从

A1

开始，在

表1

中考虑该数据：

| 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 |

其中，

键的公式为：

=C2&"|"&D2&"|"&E2&"|"&F2

建议您（按照@RonRosenfeld）使用
类
作为字典值，例如
Class1
（只需在VB编辑器中创建一个新类），然后输入：

Option Explicit

Public ConsolidatedRevenue As Double
Public FirstDate As Date
Public LastDate As Date

然后您可以使用如下代码（支持intellisense）：

因此，以下代码将：


每行循环
如果该键不在字典中，则添加该键和带有该行数据的新
Class1
如果键不是新的，则获取现有数据和增量收入，并比较日期以获取合并项目的开始和结束

代码：

您应该能够使其适应您的数据集。要对日期进行最小/最大测试，建议的代码仅使用数据包中存储的当前日期（例如
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

然后在主循环中，获取这些附加值，例如

' ... (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

将输出设置为工作表
Set wsOutput=ThisWorkbook.Worksheets（“Output”）“什么是唯一键-订单和产品的串联？@RobinMackenzie唯一ID是4列（订单#、产品、合同名称和状态）的串联。您可以使用数组，但一旦您习惯了它，它将更容易（将来也更容易维护）创建用户定义的对象（类），将数据存储在类对象中，并将该对象存储在字典中。在这个类中，你可以有一个方法来计算收入金额（或者你想做的任何事情）。一旦数据被收集到字典中，您就可以非常简单地输出数据。请参阅Chip Pearson’s以开始。@RobinMackenzie有没有办法进入该网站的“聊天”功能？我认为你的答案是正确的，但我在理解如何在子程序之外使用前两段代码时遇到了一些问题。我现在使用它的方式是“子函数或函数中的无效属性”或“未定义用户定义的类型”@RobinMackenzie Nevermind-我能够完成类的创建。我知道这很简单，但是你能暗示一下把结果“打印”到一张纸上而不是直接的窗口吗？此外，在即时窗口中，它似乎只包括键、日期和版本。当我打印到工作表时，我还需要保留所有其他列？
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
' ...

' ...
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