求助每天打印的送货单汇总到一个总表

38180203

根据论坛朋友稍做改动了一下，日期有可能会有几种格式，具体有附件。谢谢
软件是WPS2019

313667354

请看附件，是否达到你的要求

38180203

313667354 发表于 2024-5-3 16:11
请看附件，是否达到你的要求

您好，就是同一个单号如果顺序乱了的话就不能查询到，必须排在一起才能查询出来。点 新建 不会清空内容..   谢谢你辛苦了。

313667354

38180203 发表于 2024-5-3 16:48
您好，就是同一个单号如果顺序乱了的话就不能查询到，必须排在一起才能查询出来。点 新建 不会清空内容.. ...

单号乱了我这也能查询啊，至于你说新建不能清空数据，自己改一下就行了。

38180203

313667354 发表于 2024-5-3 17:12
单号乱了我这也能查询啊，至于你说新建不能清空数据，自己改一下就行了。

耐何文化水平有限

ykcbf1100

参与一下。。。

ykcbf1100

。。。。。。。。。。

ykcbf1100

更新一下。

1. Sub 查询()    '//2024.5.3
   
2.     With Sheets("单据明细")
   
3.         r = .Cells(Rows.Count, 4).End(3).Row
   
4.         arr = .[a1].Resize(r, 13)
   
5.     End With
   
6.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
7.     With Sheets("送货单")
   
8.         dh = .[i4].Value
   
9.         .[a7:j16] = ""
   
10.         For i = 3 To UBound(arr)
    
11.             If arr(i, 4) = dh Then
    
12.                 m = m + 1
    
13.                 brr(m, 1) = m
    
14.                 For j = 5 To UBound(arr, 2)
    
15.                     brr(m, j - 3) = arr(i, j)
    
16.                 Next
    
17.             End If
    
18.         Next
    
19.         .[a7].Resize(m, 10) = brr
    
20.     End With
    
21.     MsgBox "OK！"
    
22. End Sub
    
23. 
    
24. Sub 清空()
    
25.     With Sheets("送货单")
    
26.         .[i4:i5] = ""
    
27.         .[a7:j16] = ""
    
28.     End With
    
29. End Sub
    
30. 
    
31. Sub 保存()    '//2024.5.3
    
32.     Set d = CreateObject("Scripting.Dictionary")
    
33.     With Sheets("单据明细")
    
34.         r = .Cells(Rows.Count, 4).End(3).Row
    
35.         arr = .[a1].Resize(r, 13)
    
36.     End With
    
37.     For i = 3 To UBound(arr)
    
38.         s = arr(i, 4)
    
39.         d(s) = ""
    
40.     Next
    
41.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    
42.     With Sheets("送货单")
    
43.         r = .Cells(Rows.Count, 1).End(3).Row
    
44.         arr = .[a1].Resize(r, 10)
    
45.         s = .[i4].Value
    
46.         If d.exists(s) Then
    
47.             MsgBox "单号明细表中已存在，现退出重来！"
    
48.             Exit Sub
    
49.         Else
    
50.             For i = 7 To UBound(arr)
    
51.                 brr(m, 2) = .[i5].Value
    
52.                 brr(m, 3) = .[b4].Value
    
53.                 brr(m, 4) = s
    
54.                 For j = 2 To UBound(arr, 2)
    
55.                     brr(m, j + 3) = arr(i, j)
    
56.                 Next
    
57.             Next
    
58.         End If
    
59.     End With
    
60.     With Sheets("单据明细")
    
61.         r = .Cells(Rows.Count, 4).End(3).Row
    
62.         .Cells(r + 1, 1).Resize(m, 13) = brr
    
63.         .Cells(r + 1, 1).Resize(m, 13).Borders.LineStyle = 1
    
64.     End With
    
65.     MsgBox "OK！"
    
66. End Sub
    

复制代码

38180203

ykcbf1100 发表于 2024-5-3 19:13
更新一下。

老师您好，WPS下只有 "清空 "可以用