当前位置：首页 > news >正文

使用VBA嵌套字典快速转换BOM表格

news 2025/6/10 6:00:51

实例需求：产品记录表如下图所示，其中第一列为Product的为主产品，第一列为空为子产品，所有产品只存在一层从属关系，也就是说不存在子产品的子产品。注意表格中数据行的顺序不确定，子产品并不一定"跟随"其所属主产品，例如产品4向上查找，最近一个主产品是产品2，但是其主产品应该是产品1（以ParentSKU列为依据）。

在这里插入图片描述

现在需要将产品表整理为如下格式。

在这里插入图片描述

示例代码如下。

Sub Demo()Dim ws As Worksheet, brr, i As LongSet ws = ThisWorkbook.Worksheets("Sheet1")Dim arr: arr = ws.Cells(1, 1).CurrentRegion.ValueDim ColCnt As Long: ColCnt = UBound(arr, 2)ReDim brr(1 To UBound(arr) * 2, 1 To ColCnt)Dim oDic As Object: Set oDic = CreateObject("Scripting.Dictionary")For i = 2 To UBound(arr, 1)If arr(i, 1) = "Product" ThenIf Not oDic.exists(arr(i, 4)) ThenoDic.Add arr(i, 4), CreateObject("Scripting.Dictionary")oDic(arr(i, 4)).Add arr(i, 4), Array(arr(i, 2), arr(i, 8))End IfEnd IfNext iFor i = 2 To UBound(arr, 1)If Len(arr(i, 1)) = 0 And Len(arr(i, 5)) > 0 ThenIf oDic.exists(arr(i, 5)) ThenoDic(arr(i, 5)).Add arr(i, 4), Array(arr(i, 2), arr(i, 8))ElseDebug.Print "Parent product " & arr(i, 5) & " is missing."End IfEnd IfNext iFor i = 1 To ColCntbrr(1, i) = arr(1, i)Next iDim v, sKey, oSubDic As ObjectDim j As Long, k As LongDim iR As Long: iR = 1For Each v In oDic.KeysSet oSubDic = oDic(v)iR = iR + 1brr(iR, 1) = "Product"brr(iR, 2) = oSubDic.Items()(0)(0)brr(iR, 3) = "Pysical"brr(iR, 4) = vFor j = 1 To oSubDic.Count - 1sKey = oSubDic.Keys()(j)iR = iR + 1brr(iR, 1) = "Variant"brr(iR, 4) = sKeybrr(iR, 5) = vbrr(iR, 6) = oSubDic(sKey)(0)brr(iR, 7) = oSubDic(sKey)(1)Next jiR = iR + 1brr(iR, 1) = "Image"brr(iR, 8) = oSubDic.Items()(0)(1)Next vThisWorkbook.Sheets.AddWith ActiveSheet.Cells(1, 1).Resize(iR, UBound(brr, 2)).Value = brr.Borders.LineStyle = xlContinuous.EntireColumn.AutoFitEnd With
End Sub

【代码解析】
第3行代码获取数据表所在工作表对象。
第4行代码将数据表读取到数组中。
第5行代码获取数据表的列数。
第7行代码创建字典对象。
第8~15行代码循环遍历数据表并将主产品加载到字典中。
第9行代码判断第一列是否包含主产品标识。
第10行代码判断字典中是否存在当前主产品SKU编码。
如果不存在，第11行代码以SKU编码为键，添加一个字典对象（下文中检查子产品字典）作为值。
第12行代码将主产品的Name和URL添加到子产品字典中，这样便于后续代码的构建新数据表格。
第16~24行代码循环遍历数据表并将子产品加载到子产品字典中。
第17行代码判断第一列为空，并且第5列不为空，如果满足条件说明是子产品数据。
第18行代码判断主产品SKU是否存在于字典中。
如果存在，第19行代码将子产品的的Name和URL添加到子产品字典中。
如果不存在，第20行代码在【立即窗口】中输出提示信息。
第25~27行代码提取数据表标题行。
第31~50行代码循环遍历字典对象。
第32行代码读取子产品字典对象。
第34~37行代码将当前主产品写入结果数组中。
第35行从子产品字典对象中读取主产品的名称。
第38~46行代码循环遍历子产品字典对象，并填充结果数组。
第48~49行代码将主产品的URL写入结果数组。
第51行代码在当前工作簿中创建新工作表。
第52行代码获取写入结果数据的单元格区域。
第53行代码将数据写入工作表。
第54行代码添加边框线。
第55行代码应用自适应列宽。