如何根据BOM的上层数量计算下层准确数据
日期：2023-02-08 17:42:58 发布者: ICT-Dawson 浏览次数：次
众所周知，SOLIDWORKS可以通过材料明细表得到准确的带有层级的BOM信息，那么如何根据BOM的上层数量计算下层准确数据呢？
一、问题原因
众所周知，SOLIDWORKS可以通过材料明细表得到准确的带有层级的BOM信息，那么如何根据BOM的上层数量计算下层准确数据呢？
例如：
但是我们SW的BOM清单总是显示 单个装配体的数量，例如 ：
2 的数量是3
2.1的数量是2（注意这个2是单个装配体的数量，实际的数量是3X2=6）
在进行PDM的实施过程中，发现很多客户都需要在层级BOM中准确的数量。
，所以进行了一些数据查阅做出了 自动计算的VBA代码。
1.调出做好的VBA宏 ，计算数量
2.我们可以发现，所有的子层数量都做了自动的叠乘计算
众所周知，SOLIDWORKS可以通过材料明细表得到准确的带有层级的BOM信息，那么如何根据BOM的上层数量计算下层准确数据呢？
例如：
但是我们SW的BOM清单总是显示 单个装配体的数量，例如 ：
2 的数量是3
2.1的数量是2（注意这个2是单个装配体的数量，实际的数量是3X2=6）
在进行PDM的实施过程中，发现很多客户都需要在层级BOM中准确的数量。
，所以进行了一些数据查阅做出了 自动计算的VBA代码。
二、问题解决方法
1.调出做好的VBA宏 ，计算数量
2.我们可以发现，所有的子层数量都做了自动的叠乘计算
三、VBA代码分享
Dim iRow As Long
For iRow = LBound(ArrQty, 1) To UBound(ArrQty, 1)
Dim ParentItem As String 'get parent item number
Dim CurrentItem As String
CurrentItem = ArrItm(iRow, 1)
Dim LastDotPosition As Long
LastDotPosition = InStrRev(CurrentItem, ".")
Dim ParentMatch As Double
ParentMatch = 0 'initialize because in loop
Do While LastDotPosition > 0 And ParentMatch = 0 'loop through parent levels until parent is found or no parent exists
ParentItem = Left$(CurrentItem, LastDotPosition - 1)
ParentMatch = 0 'initialize because in loop
On Error Resume Next 'next line throws error if no parent item is found
ParentMatch = Application.WorksheetFunction.Match(ParentItem, ArrItm, 0)
On Error GoTo 0 're-enable error reporting
If Not ParentMatch = 0 Then 'if there was a parent item multiplicate current quantity with parent quantity
ArrQty(iRow, 1) = ArrQty(iRow, 1) * ArrQty(ParentMatch, 1)
Else 'if parent item did not match then try to find the next upper level parent item
CurrentItem = ParentItem
LastDotPosition = InStrRev(CurrentItem, ".")
End If
DoEvents
Loop
Next iRow 'write array quantity back to cells
ws.Range("N2").Resize(RowSize:=UBound(ArrQty, 1)).Value = ArrQty
End Sub
通过此步骤便可 轻松计算数量！
Dim iRow As Long
For iRow = LBound(ArrQty, 1) To UBound(ArrQty, 1)
Dim ParentItem As String 'get parent item number
Dim CurrentItem As String
CurrentItem = ArrItm(iRow, 1)
Dim LastDotPosition As Long
LastDotPosition = InStrRev(CurrentItem, ".")
Dim ParentMatch As Double
ParentMatch = 0 'initialize because in loop
Do While LastDotPosition > 0 And ParentMatch = 0 'loop through parent levels until parent is found or no parent exists
ParentItem = Left$(CurrentItem, LastDotPosition - 1)
ParentMatch = 0 'initialize because in loop
On Error Resume Next 'next line throws error if no parent item is found
ParentMatch = Application.WorksheetFunction.Match(ParentItem, ArrItm, 0)
On Error GoTo 0 're-enable error reporting
If Not ParentMatch = 0 Then 'if there was a parent item multiplicate current quantity with parent quantity
ArrQty(iRow, 1) = ArrQty(iRow, 1) * ArrQty(ParentMatch, 1)
Else 'if parent item did not match then try to find the next upper level parent item
CurrentItem = ParentItem
LastDotPosition = InStrRev(CurrentItem, ".")
End If
DoEvents
Loop
Next iRow 'write array quantity back to cells
ws.Range("N2").Resize(RowSize:=UBound(ArrQty, 1)).Value = ArrQty
End Sub
通过此步骤便可 轻松计算数量！
