在表格中排列折叠数据

Question

我有一个折叠数据，如下所示，我有ID＆amp;它的标题下面的标题，其值存在。每个ID都有自己不同的标题和标题。值。

我必须将它们安排到一个表中，其中我将所有ID的标头合并为一行，并且ID在一列中。基于ID，我需要在下面更新相应的标头值。

ID--+--H1--+--H2--+--H3--+--H4--+--H5--|
18219--V1--+--V3--+--  --+--  --+--  --|    
18218--V2--+--V4--+--  --+--  --+--  --|
18217--V1--+--V2--+--V3--+--V4--+--V5--|

任何人都可以帮助我吗？

Answer 1

试试这段代码：

Option Explicit

Sub Consolidate()

    Dim arrContent As Variant
    Dim strSource As String
    Dim strDest As String
    Dim x As Long
    Dim y As Long
    Dim p As Long
    Dim objHeader As Object
    Dim objItem As Variant
    Dim lngColsCount As Long

    ' set initial values
    strSource = "source" ' source worksheet name
    strDest = "destination" ' destination worksheet name
    y = 1 ' source worksheet first ID cell's row number
    x = 2 ' source worksheet first ID cell's column number
    Set objHeader = CreateObject("Scripting.Dictionary")

    ' pack source data into array of dictionaries
    objHeader.Add "ID", 0
    arrContent = Array()
    With Sheets(strSource)
        Do While .Cells(y, x).Value <> "" And .Cells(y + 1, x).Value = ""
            Set objItem = CreateObject("Scripting.Dictionary")
            objItem.Add 0, .Cells(y, x).Value
            p = x + 1
            Do While .Cells(y, p).Value <> ""
                If Not objHeader.Exists(.Cells(y, p).Value) Then objHeader.Add .Cells(y, p).Value, objHeader.Count
                objItem(objHeader(.Cells(y, p).Value)) = .Cells(y + 1, p).Value
                p = p + 1
            Loop
            ReDim Preserve arrContent(UBound(arrContent) + 1)
            Set arrContent(UBound(arrContent)) = objItem
            y = y + 2
        Loop
    End With

    ' output
    With Sheets(strDest)
        .Cells.Delete
        lngColsCount = UBound(objHeader.keys)
        .Range(.Cells(1, 1), .Cells(1, lngColsCount + 1)).Value = objHeader.keys
        y = 2
        For Each objItem In arrContent
            For x = 1 To lngColsCount + 1
                .Cells(y, x).Value = objItem(x - 1)
            Next
            y = y + 1
        Next
    End With

End Sub

对于源表：

它生成输出：