Question

我有一些时间表数据，我需要简化，似乎无法在任何地方找到宏。我已经看到了一些类似的东西，但需要一个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

任何接受者？谢谢！

Answer 1

你起草了一些代码吗？我们可以尝试帮助您解决问题，改进代码......

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

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

瞧。

示例代码，执行部分操作（不打印，但将值相加并将它们存储回字典中）。

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

编辑：要使用scripting.dictionary，请转到工具/参考，然后选中“Microsoft Scripting Runtime”。

编辑＃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

希望它有所帮助。

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

1 个答案: