求大神帮忙优化一下代码

tracysimple

根据BOM表及产品入库表自动分解出生产领料表，代码是叫人帮忙弄的，但是运行出现错误，有没有大神帮忙优化一下呢？

听歌的海

参与一下，没有分解BOM的规则，只是不让程序报错，

1. Sub GenerateProductionPickList()
   
2.     Dim bomSheet As Worksheet
   
3.     Dim 入库Sheet As Worksheet
   
4.     Dim 领料Sheet As Worksheet
   
5.     Dim lastRowBOM As Long
   
6.     Dim lastRow入库 As Long
   
7.     Dim i As Long, j As Long, k As Long
   
8.     Dim productCode As String
   
9.     Dim productQty As Long
   
10.    
    
11.     '设置工作表对象
    
12.     Set bomSheet = ThisWorkbook.Worksheets("BOM表")
    
13.     Set 入库Sheet = ThisWorkbook.Worksheets("产品入库表")
    
14.     Set 领料Sheet = ThisWorkbook.Worksheets("生产领料表")
    
15.    
    
16.     '获取 BOM 表和产品入库表的最后一行行号
    
17.     lastRowBOM = bomSheet.Cells(bomSheet.Rows.Count, 1).End(xlUp).Row
    
18.     lastRow入库 = 入库Sheet.Cells(入库Sheet.Rows.Count, 1).End(xlUp).Row
    
19.    
    
20.     '清空生产领料表现有数据（除标题行）
    
21.    领料Sheet.Range("A2:C" & 领料Sheet.Rows.Count).ClearContents
    
22.    
    
23.     k = 1 '生产领料表的行号计数器
    
24.    
    
25.     '遍历产品入库表
    
26.     For i = 2 To lastRow入库
    
27.         productCode = 入库Sheet.Cells(i, 1).Value
    
28.         productQty = 入库Sheet.Cells(i, 3).Value
    
29.         
    
30.         '遍历 BOM 表，查找对应产品的物料需求
    
31.         For j = 2 To lastRowBOM
    
32.             If bomSheet.Cells(j, 1).Value = productCode Then
    
33.                 '计算物料的领用数量
    
34.                 Dim pickQty As Long
    
35.                 pickQty = bomSheet.Cells(j, 5).Value * productQty
    
36.                
    
37.                 '将数据写入生产领料表
    
38.                领料Sheet.Cells(k + 1, 1).Value = productCode
    
39.                领料Sheet.Cells(k + 1, 2).Value = 入库Sheet.Cells(i, 2).Value
    
40.                领料Sheet.Cells(k + 1, 3).Value = bomSheet.Cells(j, 3).Value
    
41.                领料Sheet.Cells(k + 1, 4).Value = bomSheet.Cells(j, 4).Value
    
42.                领料Sheet.Cells(k + 1, 5).Value = pickQty
    
43.                
    
44.                 k = k + 1
    
45.             End If
    
46.         Next j
    
47.     Next i
    
48. End Sub

复制代码

chxw68

不出错了。

袁勇

1. Private Sub CommandButton1_Click()
   
2.     Dim i&, j&, k&, arr, brr, crr()
   
3.     arr = Sheets("BOM表").[a1].CurrentRegion
   
4.     brr = Sheets("产品入库表").[a1].CurrentRegion
   
5.     ReDim crr(1 To UBound(arr), 1 To 5)
   
6.    
   
7.     For j = 2 To UBound(brr)
   
8.         For i = 2 To UBound(arr)
   
9.             If arr(i, 1) = brr(j, 1) Then
   
10.                 k = k + 1
    
11.                 crr(k, 1) = arr(i, 1)
    
12.                 crr(k, 2) = arr(i, 2)
    
13.                 crr(k, 3) = arr(i, 3)
    
14.                 crr(k, 4) = arr(i, 4)
    
15.                 crr(k, 5) = arr(i, 5) * brr(j, 3)
    
16.             End If
    
17.         Next
    
18.     Next
    
19.    
    
20.     Sheets("生产领料表").[a1].CurrentRegion.Offset(1).ClearContents
    
21.     Sheets("生产领料表").[a2].Resize(k, 5) = crr
    
22.     Sheets("生产领料表").Select
    
23. End Sub

复制代码

tracysimple

chxw68 发表于 2024-12-17 15:24
不出错了。

感谢感谢

tracysimple

袁勇 发表于 2024-12-17 15:30

感谢感谢

tracysimple

听歌的海 发表于 2024-12-17 15:14
参与一下，没有分解BOM的规则，只是不让程序报错，

感谢感谢