时间戳

首页 > 解决方案 > Excel 中的从属值列表

excel - Excel 中的从属值列表

问题描述

我们在 Excel 中获取以下格式的数据：

在此处输入图像描述

正如我们在上面的截图中看到的：

Item1 仅映射到 1 个值 = Data1。（A 栏和 B 栏）

Item2 映射到 Data11 和 Data12。（A 栏和 B 栏）

Item2 Data11 和 Data12 也映射到 Item1.Data1（AB 列和 CD 列）

对于整个映射，我们得到的值

我们想使用 VBA 透视数据并以以下格式显示它（我们有 9 列 Item1 到 Item9。为简单起见，我们在下面只添加了 3 列）： 在此处输入图像描述

我们进行了头脑风暴，但没有得到任何答案。请帮助我们实现这一目标的最佳方法是什么？

标签： excelvba

解决方案

创建一个名为的类模块clsObj来存储父子关系。

Option Explicit

Public UID As String
Public Level As Integer
Public Children As New Collection

Sub addChild(child As clsObj)

    Dim bExists As Boolean, n As Long
    For n = 1 To Me.Children.Count
        If Me.Children(n).UID = child.UID Then
            bExists = True
            Exit For
        End If
    Next
    If Not bExists Then
        Me.Children.add child, child.UID
    End If

End Sub

Sub output(rngOut, ByRef ar)

    Dim child As Object, iLevel As Integer, n As Integer
    iLevel = Me.Level
    
    ' clear lower levels
    For n = iLevel To UBound(ar)
        ar(n) = ""
    Next
    ar(iLevel) = Me.UID

    ' print out if lowest level
    If Me.Children.Count = 0 Then
        For n = 1 To UBound(ar)
            rngOut.Offset(0, n - 1) = ar(n)
        Next
        Set rngOut = rngOut.Offset(1)
    Else
        For Each child In Me.Children
            ' recurse down next level
            child.output rngOut, ar
        Next
    End If

End Sub

扫描创建对象的输入表。将对象存储在字典中（每个级别一个）以供后续检索

Option Explicit

Sub process()

   Dim wb As Workbook, wsIn As Worksheet, wsOut As Worksheet
   Dim iLastRow As Long, r As Long, i As Integer
   Dim sUID As String, iLevel As Integer
   
   Set wb = ThisWorkbook
   Set wsIn = wb.Sheets("Sheet1")

   Dim dict(9) As Object, key, obj1 As clsObj, obj2 As clsObj
   For i = 1 To 9
       Set dict(i) = CreateObject("Scripting.Dictionary")
   Next

   iLastRow = wsIn.Cells(Rows.Count, "A").End(xlUp).Row
   For r = 1 To iLastRow
    
       iLevel = Mid(wsIn.Cells(r, "A"), 5)
       sUID = wsIn.Cells(r, "B")
       If dict(iLevel).exists(sUID) Then
           Set obj1 = dict(iLevel).Item(sUID)
       Else
           ' new item
           Set obj1 = New clsObj
           obj1.UID = sUID
           obj1.Level = iLevel
           dict(iLevel).add sUID, obj1
       End If

       ' child
       iLevel = Mid(wsIn.Cells(r, "C"), 5)
       sUID = wsIn.Cells(r, "D")
       If dict(iLevel).exists(sUID) Then
            Set obj2 = dict(iLevel).Item(sUID)
       Else
            ' new item
            Set obj2 = New clsObj
            obj2.UID = sUID
            obj2.Level = iLevel
            dict(iLevel).add sUID, obj2
       End If
       obj1.addChild obj2

    Next

    ' result to sheet2
    Dim ar(9) As String, rngOut As Range
    Set wsOut = wb.Sheets("Sheet2")
    wsOut.Cells.Clear
    For iLevel = 1 To 9
        wsOut.Cells(1, iLevel) = "Item " & iLevel
    Next
    Set rngOut = wsOut.Range("A2")
    For Each key In dict(1)
        dict(1)(key).output rngOut, ar
    Next
    MsgBox "Done"

End Sub

推荐阅读