在表格中排列折叠的数据答案

【问题标题】：Arranging collapsed data in a table在表格中排列折叠的数据
【发布时间】：2015-07-09 16:26:04
【问题描述】：

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

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

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

谁能帮帮我？

【问题讨论】：

标签： excel vba

【解决方案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

对于源表：

它产生输出：

【讨论】：

嗨@omegastripes，非常感谢您的帮助。我在“.Cells.Delete”和“With Sheets(strSource)”上遇到错误。希望我们需要将值转换为字符串，请您看一下。
请忽略之前的评论。现在宏正在运行，但我所有的标题和 ID 都在目标表中消失了。（我没有在上面的代码中修改任何东西）。我在源表中有 9300 行，每个 ID 都有不同的编号。标题。
在我的答案中查看源工作表和目标工作表的屏幕截图（打开全尺寸以获得详细视图）。它们看起来像你需要的吗？
是的，但在我的文件中，它只给了我一张空白的目标表。我错过了什么？
我使用 excel 2007 有问题吗？