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

我有一些需要简化的时间表数据，似乎在任何地方都找不到宏。 我见过一些类似的东西，但需要一个vba来修改实际数据，因为在这一步之后，我使用了其他几个宏来进一步修改数据/外观

在一天中，我们可能会在不同的时间处理一个案例，因此我们会在案例中创建多个条目

我需要一个宏，将每一行与所有其他行进行比较，因为数据常常不相邻，然后将其合并。如果案例编号（G）、计费状态（B）和日期（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

因此，宏需要将行组合为：

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

---

有人要吗？谢谢

你起草了一些代码吗？我们可以尝试帮助您找到解决方案，改进您的代码

我会这样做（如果您不知道如何构建代码，请询问，我们会帮助您）：

• 创建Dictionary对象（在VBA中消除重复信息的最佳方法）
• 扫描每一行，将所有索引值的串联添加到字典键中，并将每个列的值作为该键的值添加到一个数组中
• 当检测到密钥已存在时，请计算所需列的总和（例如分钟）
• 将词典打印回电子表格

瞧

示例代码，这是技巧的一部分（不打印回，而是对值求和并将其存储回字典）

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

编辑：要使用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

---

希望有帮助。

是的，我需要一些更详细的代码步骤，我不太擅长这一点。只是想改进以前做过的事情。更新后。。。现在是代码。我相信在这里挖起来很容易就能填补这些空白。不过，如果你有问题。。。给我们喊一声。这看起来太简单了，不可能是真的，但我能看到它是如何工作的。我会看看是否能找到一些打印脚本字典的步骤。如果你有机会的话，多给点建议会有帮助的。谢谢，我甚至不清楚这本词典是什么，更不用说我是如何从中打印出来的了。我能借用你更多的天赋吗？@David，代码更新了，现在把数据打印回来。。。如果它符合您的要求，我将非常感谢“检查作为答案”（我的帖子左侧的绿色v）来确认您的问题是否得到了回答。