如何將相似的記錄跨表分組？

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