vba怎么实现一个表数据更新另一表同步计算求和

wx_52533

各位老师求助一下。在订单汇总表中需要在日期下求得交货计划表里对应日期下相同物料编码的和，也就是每日客户需求的和。交货计划表更新订单汇总同步更新。并且第三行日期随意更改其他日期仍有效果，怎么实现啊求助大佬

蓝桥玄霜

计划的例子：

Qs18

1. Sub qs()
   
2. Application.ScreenUpdating = False
   
3. Dim arr, i, dic
   
4. Set dic = CreateObject("scripting.dictionary")
   
5. arr = Sheet1.UsedRange.Value
   
6. m = 1: n = 4
   
7. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
8. brr(1, 1) = "序号": brr(1, 2) = "物料编码": brr(1, 3) = "库存数量)"
   
9. ReDim crr(1 To UBound(arr), 1 To 1)
   
10. For i = 2 To UBound(arr)
    
11.     For j = 5 To UBound(arr, 2)
    
12.             If IsDate(arr(1, j)) And arr(1, j) <> "" Then '时间
    
13.                     dt = CDate(arr(1, j))
    
14.                     s = arr(i, 1) & "|" & arr(1, j)
    
15.                         
    
16.                         If Not dic.exists(s) Then
    
17.                             dic(s) = arr(i, j)
    
18.                         Else
    
19.                             dic(s) = dic(s) + arr(i, j)
    
20.                         End If
    
21.                     If Not dic.exists(dt) Then
    
22.                         n = n + 1
    
23.                         brr(1, n) = arr(1, j)
    
24.                         dic(dt) = n
    
25.                     End If
    
26.             End If
    
27.         Next
    
28. 
    
29. 
    
30.     bm = arr(i, 1)
    
31.     If bm <> Empty Then
    
32.         If Not dic.exists(bm) Then '物料编码
    
33.             m = m + 1
    
34.             brr(m, 1) = bm
    
35.             dic(bm) = m
    
36.             crr(m, 1) = m
    
37.         End If
    
38.     End If
    
39. Next
    
40. 
    
41. For ii = 2 To m
    
42.     For jj = 5 To n
    
43.         s = brr(ii, 1) & "|" & brr(1, jj)
    
44.         brr(ii, jj) = dic(s)
    
45.     Next
    
46. Next
    
47. With Sheet3
    
48. .Range("a3").Resize(50000, 300).ClearContents
    
49. .Range("b3").Resize(m, n) = brr
    
50. .Range("a3").Resize(m, 1) = crr
    
51. .ListObjects.Add xlSrcRange, .Range("a3").Resize(m, n + 1), , xlYes
    
52. End With
    
53. Set dic = Nothing
    
54. Application.ScreenUpdating = True
    
55. End Sub
    

复制代码

Qs18

试试..........

Qs18

试试..........

wx_52533

Qs18 发表于 2024-9-26 14:05
试试..........

正确的，谢谢老师，真的很感谢，才认识vba前两天想了很久找了很多资料

Qs18

wx_52533 发表于 2024-9-26 15:41
正确的，谢谢老师，真的很感谢，才认识vba前两天想了很久找了很多资料

没事，我也是跟着论坛里面的大佬在学习呢

wx_52533

Qs18 发表于 2024-9-26 16:03
没事，我也是跟着论坛里面的大佬在学习呢

这个每次是清除数据写入，我需要给日期前加上其他列数据，不要清除有没有办法啊。这个程序是依据表格写入的吗标题行必须是这样吗能不能改啊