如果特定数据相同，则合并行

我有一些时间表数据，我需要简化，似乎无法在任何地方findmacros。 我已经看到了一些类似的东西，但需要一个vba来修改实际的数据，因为在这一步之后我使用其他一些macros来修改数据/外观更远。

在白天，我们可能会在几个不同的时间工作，所以我们在案例中创build了几个条目。

我需要一个macros来比较每一行和其他所有的数据，因为这些数据往往不是彼此相邻，然后将它们合并。 如果案例编号（G），计费状态（B）和date（A）相同，我想合并两行，但将两个列的时间加在一起分钟（E）和小时（F）

样本数据：

Data(A) Bill(B) Contact(C) Customer(D) Min(E) Hours(F)Case#(G) ---------------------------------------------------------------- 7/5/2011 No Lynda Customer1 15.000 0.25 524503 7/5/2011 No Adam Customer2 15.000 0.25 523592 7/5/2011 No Adam Customer2 15.000 0.25 523592 7/6/2011 No Adam Customer2 15.000 0.25 523592 

所以macros需要将这些行结合起来看起来像这样：

 7/5/2011 No Lynda Customer1 15.000 0.25 524503 7/5/2011 No Adam Customer2 30.000 0.5 523592 7/6/2011 No Adam Customer2 15.000 0.25 523592 

任何接受者？ 谢谢！

Answer 1

你起草了一些代码吗？ 我们可以尝试帮助您达到您的解决scheme，改善您的代码…

我会这样（如果你不知道如何构build代码，请问我们会帮助你）：

• 创build一个Dictionary对象（在VBA中摆脱重复信息的最好方法）
• 扫描每一行，在Dictionary 键中添加所有索引值的连接，并为此键的值使用每列值
• 当检测到密钥已经存在时，执行所需列的总和（例如分钟）
• 打印回字典到电子表格

瞧。

示例代码，这是做的一部分技巧（不打印回来，但总结价值和存储他们回到词典）。

我正在直接存储单元而不是它们的值，因为现在我没有太多的时间来处理数组了。

编辑：要使用scripting.dictionary，去工具/引用，并检查“Microsoft脚本运行时”。

编辑＃2：添加了打印分组数据的代码。 您可能需要根据您的要求调整代码…但这是回答您的问题。

 Option Explicit Sub test() Dim oRange As Excel.Range Dim oTarget As Excel.Range Dim oRow As Excel.Range Dim oRowAmend As Excel.Range Dim oDic As Scripting.Dictionary Dim sIndex As String Dim vKey As Variant Dim vItem As Variant 'Define the source range. Remember to bypass the header! Set oRange = Sheets("MySheet").Range("A2:G5") 'Define where the updated data will be printed... Set oTarget = Sheets("MySheet").Range("A12:G12") Set oDic = New Scripting.Dictionary For Each oRow In oRange.Rows 'Define Indexes sIndex = Trim(oRow.Cells(1)) & Trim(oRow.Cells(2)) & Trim(oRow.Cells(3)) 'If the index exists, sum the values If oDic.Exists(sIndex) Then Set oRowAmend = oRow oRowAmend.Cells(5).Value = oRow.Cells(5).Value + oRowAmend.Cells(5).Value 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 

希望能帮助到你。