请高手帮忙看看这个辅料表的出入库如何做？

pjdong

新手实在不会做，请帮忙看看如何把领用和入库两个表的信息录入到辅材日报表里。相关信息请看附件，谢谢！

3190496160

这种问题，恐怕不是义务能够解决的

pjdong

3190496160 发表于 2024-7-29 09:36
这种问题，恐怕不是义务能够解决的

好的，谢谢

titi012

参与一下，，，，
做了一个领用的，入库的楼主可以参考着自己做，

1. Sub 辅料表出库()
   
2.     Application.ScreenUpdating = False '//关闭屏幕刷新
   
3.     Application.DisplayAlerts = False '//关闭系统提示
   
4.     Application.EnableEvents = False  '//禁止触发其他事件
   
5.     Application.StatusBar = True   '关闭系统状态
   
6.    
   
7.     Dim Wk As Workbook, xWk As Workbook
   
8.     Dim MyPath$, xStr$, yStr$
   
9.     Dim x&, y&, a&, b&, c&
   
10.     Dim Arr, Brr
    
11.     Dim xBoo As Boolean
    
12.    
    
13.     xBoo = True
    
14.     For Each Wk In Workbooks
    
15.         If Wk.Name Like "2024辅材日报表.xlsx" Then
    
16.             xBoo = False
    
17.             Set xWk = Wk
    
18.             Exit For
    
19.         End If
    
20.     Next
    
21.     Set Wk = ThisWorkbook
    
22.     If xBoo Then Set xWk = Workbooks.Open(Wk.Path & "\2024辅材日报表.xlsx")
    
23.    
    
24.     With Wk.Sheets("领用")
    
25.         a = .Cells(Rows.Count, 2).End(xlUp).Row
    
26.         Arr = .Range("b4:l" & a)
    
27.     End With
    
28.     With xWk.Sheets("辅料日报")
    
29.         a = .Cells(Rows.Count, 2).End(xlUp).Row
    
30.         Brr = .Range("a5:de" & a)
    
31.     End With
    
32.    
    
33.     For x = LBound(Arr) To UBound(Arr)
    
34.         a = 0: b = 0: c = Day(Arr(x, 1)) * 3 + 15
    
35.         For y = LBound(Brr) To UBound(Brr)
    
36.             If Arr(x, 2) Like Brr(y, 4) And Arr(x, 5) Like Brr(y, 7) Then
    
37.                 a = a + Brr(y, 16)
    
38.                 If a > Arr(x, 7) Then
    
39.                     Brr(y, c) = Arr(x, 7) - b
    
40.                     Exit For
    
41.                 Else
    
42.                     Brr(y, c) = Brr(y, 16)
    
43.                     b = b + Brr(y, 16)
    
44.                 End If
    
45.             End If
    
46.         Next y
    
47.         If a < Arr(x, 7) Then MsgBox Arr(x, 2) & " 库存不足"
    
48.     Next x
    
49.    
    
50.     With xWk.Sheets("辅料日报")
    
51.         a = .Cells(Rows.Count, 2).End(xlUp).Row
    
52.         .Range("a5:de" & a) = Brr
    
53.     End With
    
54.    
    
55.     Application.StatusBar = False   '//恢复系统状态条
    
56.     Application.EnableEvents = True  '// 恢复触发其他事件
    
57.     Application.ScreenUpdating = True '//恢复屏幕刷新
    
58.     Application.DisplayAlerts = True '//恢复系统提示
    
59. End Sub

复制代码