ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 4972|回复: 29

[求助] 生产管理BOM计算案例

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-5-9 11:10 | 显示全部楼层 |阅读模式
BOM关系示意
file:///C:/Users/ADMINI~1/AppData/Local/Temp/msohtmlclip1/01/clip_image002.png  
  
A1液晶面板  
file:///C:/Users/ADMINI~1/AppData/Local/Temp/msohtmlclip1/01/clip_image004.png
  
B1硅板
  
file:///C:/Users/ADMINI~1/AppData/Local/Temp/msohtmlclip1/01/clip_image006.png
  
A2遥控器B2遥控板
B3电池
AAAA
A3架子
  
file:///C:/Users/ADMINI~1/AppData/Local/Temp/msohtmlclip1/01/clip_image008.png
  
B4原器件
A4主板B5电阻
B6电珠
B7电子
file:///C:/Users/ADMINI~1/AppData/Local/Temp/msohtmlclip1/01/clip_image010.png  
  
A1液晶面板  
file:///C:/Users/ADMINI~1/AppData/Local/Temp/msohtmlclip1/01/clip_image011.png
  
B1硅板
SJ
file:///C:/Users/ADMINI~1/AppData/Local/Temp/msohtmlclip1/01/clip_image008.png  
  
B4原器件
A4主板B5电阻
B6电珠
B7电子

BOM案列.rar

12.26 KB, 下载次数: 55

TA的精华主题

TA的得分主题

发表于 2018-5-9 12:52 | 显示全部楼层
Option Explicit

Sub test()
  Dim arr, i, j, k, t, brr, cnt
  With Sheets("目标")
    arr = .Range("b3:e" & .Cells(Rows.Count, "b").End(xlUp).Row)
  End With
  With Sheets("BOM")
    brr = .[a1].CurrentRegion
    ReDim crr(1 To Rows.Count, 1 To 5)
    For i = 1 To UBound(arr, 1)
      t = arr(i, 1) & arr(i, 2) & arr(i, 3)
      For j = 1 To UBound(brr, 1)
        If t = brr(j, 1) & brr(j, 2) & brr(j, 3) Then
          cnt = cnt + 1
          For k = 1 To UBound(crr, 2) - 1
            crr(cnt, k) = brr(j, k + 3)
          Next
          crr(cnt, k) = arr(i, 4)
          Call dfs(arr, brr, crr, brr(j, 4), cnt, i)
        End If
    Next j, i
    With .[j2] '输出位置,自己修改
      .Resize(Rows.Count - 1, UBound(crr, 2)).ClearContents
      .Resize(cnt, UBound(crr, 2)) = crr
    End With
  End With
End Sub

Function dfs(arr, brr, crr, s, cnt, pos)
  Dim i, j
  For i = 2 To UBound(brr, 1)
    If s = brr(i, 1) Then
      cnt = cnt + 1
      For j = 1 To UBound(crr, 2) - 1
        crr(cnt, j) = brr(i, j + 3)
      Next
      crr(cnt, j) = arr(pos, 4)
      Call dfs(arr, brr, crr, brr(i, 4), cnt, pos)
    End If
  Next
End Function

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-5-9 16:11 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-5-9 18:07 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-5-9 21:16 | 显示全部楼层
zpy2 发表于 2018-5-9 18:07
这里 中间层 b1 b2的数量 不需要?

需要的,需要算出1级BOM,2级BOM,直到最终的材料都要算出来

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-5-11 10:08 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

老师,发现个问题,数量关系不对啊,我现在数量关系是1,算出来都是对的,如果变成2,程序算出来的数量还是不变,这里错掉了

TA的精华主题

TA的得分主题

发表于 2018-5-11 11:34 | 显示全部楼层
itmwdtn 发表于 2018-5-11 10:08
老师,发现个问题,数量关系不对啊,我现在数量关系是1,算出来都是对的,如果变成2,程序算出来的数量还 ...

'来朵小花先给咱提点精神
'没注意,修改了一下再试试。这题目好像还有点实用价值的

Option Explicit

Sub test()
  Dim arr, i, j, k, t, brr, cnt
  With Sheets("目标")
    arr = .Range("b3:e" & .Cells(Rows.Count, "b").End(xlUp).Row)
  End With
  With Sheets("BOM")
    brr = .[a1].CurrentRegion
    ReDim crr(1 To Rows.Count, 1 To 5)
    For i = 1 To UBound(arr, 1)
      t = arr(i, 1) & arr(i, 2) & arr(i, 3)
      For j = 1 To UBound(brr, 1)
        If t = brr(j, 1) & brr(j, 2) & brr(j, 3) Then
          cnt = cnt + 1
          For k = 1 To UBound(crr, 2) - 1
            crr(cnt, k) = brr(j, k + 3)
          Next
          crr(cnt, k) = arr(i, 4) * brr(j, 8)
          Call dfs(brr, crr, brr(j, 4), cnt, arr(i, 4) * brr(j, 8))
        End If
    Next j, i
    With .[j2]
      .Resize(Rows.Count - 1, UBound(crr, 2)).ClearContents
      .Resize(cnt, UBound(crr, 2)) = crr
    End With
  End With
End Sub

Function dfs(brr, crr, s, cnt, n)
  Dim i, j
  For i = 2 To UBound(brr, 1)
    If s = brr(i, 1) Then
      cnt = cnt + 1
      For j = 1 To UBound(crr, 2) - 1
        crr(cnt, j) = brr(i, j + 3)
      Next
      crr(cnt, j) = n * brr(i, 8)
      Call dfs(brr, crr, brr(i, 4), cnt, n * brr(i, 8))
    End If
  Next
End Function

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-5-11 13:01 | 显示全部楼层
一把小刀闯天下 发表于 2018-5-11 11:34
'来朵小花先给咱提点精神
'没注意,修改了一下再试试。这题目好像还有点实用价值的

AAAA        A1        液晶面板        1A        块        100
AAAA        A2        遥控器        2A        个        100
AAAA        A3        架子        3A        个         100
AAAA        A4        主板        4A        块        100
AAAA        B1        硅板        B        平方        100
AAAA        B2        遥控板        BB        个        100
AAAA        B3        电池        BBB        只        100
AAAA        B4        原器件        Ba        个        100
AAAA        B5        电阻        bs        个        100
AAAA        B6        电珠        bv        个        100
AAAA        B7        电子        bn        个        100
SJ        A1        液晶面板        1A        块        200
SJ        A4        主板        4A        块        200
SJ        B1        硅板        B        平方        200
SJ        B4        原器件        Ba        个        200
SJ        B5        电阻        bs        个        200
SJ        B6        电珠        bv        个        200
SJ        B7        电子        bn        个        200
老师,怎么将所有相应子件的,主件也列上去,

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-5-11 13:43 | 显示全部楼层
一把小刀闯天下 发表于 2018-5-11 11:34
'来朵小花先给咱提点精神
'没注意,修改了一下再试试。这题目好像还有点实用价值的

怎么送小花~~找不到额~~~

TA的精华主题

TA的得分主题

发表于 2018-5-11 13:47 | 显示全部楼层
itmwdtn 发表于 2018-5-11 13:43
怎么送小花~~找不到额~~~

说说而已,不管它。

因为你这问题有点意思,修改后能满足要求吗?
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 08:27 , Processed in 0.054816 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表