如何将相似的记录组合在一起？

Question

我需要创建一个宏来帮助将来自多个工作表的相似记录分组（实际上是6个具有可变n°记录的工作表）并将结果放在摘要表中找到所有值。

例如，我有2张（月）。每张纸都有这种记录。每张纸都有独特的记录（ColA和ColB组合）。但在其他表格中，我可以找到相同的ColA ColB组合，但在ColC中具有不同的价值。

第1页

ColA ColB ColC

AAA 111 2

BBB 111 3

CCC 222 50

第2页

ColA ColB ColC

AAA 111 2

CCC 222 50

DDD 111 20

预期结果

ColA ColB ColC

AAA 111 2,2

BBB 111 3,0

CCC 222 50,50

DDD 111 0,20

正如您所看到的，当我浏览其他工作表时，可能会弹出新值，因此我需要添加它们，表示前几个月的零值。类似的情况是当您在第一张纸中找到值时，但是它没有出现在其他表格中。

我只有几行代码只能完成工作的一部分，所以任何帮助都非常受欢迎。

Answer 1

尝试下面的内容 - 看起来有点乱，但实际上有一种方法可以解决这个问题。作为最后的触摸，如果您希望在目标表中按字母顺序排序结果 - 您可能希望在代码的末尾添加排序例程。

请勿忘记在运行

之前的两个部分中输入您的工作表名称信息

Sub concat_values()

    Dim ws As Worksheet
    Dim dic As Object
    Dim wscoll As Collection
    Dim i As Integer
    Dim cell As Range

    Set wscoll = New Collection

    'Enter your source sheets names here
    wscoll.Add Worksheets("Sheet1")
    wscoll.Add Worksheets("Sheet2")
    wscoll.Add Worksheets("Sheet3")
    wscoll.Add Worksheets("Sheet4")
    wscoll.Add Worksheets("Sheet5")
    wscoll.Add Worksheets("Sheet6")

    Set dic = CreateObject("Scripting.Dictionary")
    n = 1

    For Each ws In wscoll

        For Each cell In ws.Range("A1:A" & ws.Range("A" & ws.Rows.count).End(xlUp).row).Cells

            mykey = cell.Value & "/" & cell.Offset(0, 1).Value

            If n >= 2 Then
                For j = 1 To n - 1
                    myval = myval & "0,"
                Next j
            End If

            myval = myval & cell.Offset(0, 2).Value

            If n <= wscoll.count - 1 Then
                For j = n To wscoll.count - 1
                    myval = myval & ",0"
                Next
            End If

            On Error GoTo ERREUR
            dic.Add mykey, myval
            On Error GoTo 0

            mykey = ""
            myval = ""

        Next cell
        n = n + 1

    Next ws

    i = 1

    'Enter your destination sheet name here
    With Worksheets("DEST")
        For Each k In dic.Keys
            .Range("A" & i).Value = Mid(k, 1, InStr(k, "/") - 1)
            .Range("B" & i).Value = Mid(k, InStr(k, "/") + 1, Len(k))
            .Range("C" & i).Value = dic(k)
            i = i + 1
        Next k
    End With

    Exit Sub

ERREUR:

    count = 1

    For j = 1 To n - 1
        count = InStr(count + 1, dic(mykey), ",")
    Next j

    dic(mykey) = WorksheetFunction.Replace(dic(mykey), count + 1, 1, cell.Offset(0, 2).Value)
    Resume Next

End Sub