求助VBA统计数据

天真无鞋

输入日期获取【数据原】的日期、拉别、产品型号、统计总数量，详见附加信息！

swl4561255

1. Sub test()
   
2. ar = Sheets("数据源").Range("A1").End(4).Row
   
3. arr = Sheets("数据源").Range("A2:R" & ar)
   
4. Dim brr(1 To 100, 1 To 6)
   
5. myr = Array(12, 9, 16, 18, 4)
   
6. For i = 1 To ar - 1
   
7.     If Int(arr(i, 12)) = [B3] Then
   
8.         m = m + 1
   
9.         brr(m, 1) = m
   
10.         For j = 2 To 6
    
11.             brr(m, j) = arr(i, myr(j - 2))
    
12.         Next
    
13.     End If
    
14. Next
    
15. [A4].Resize(1, 6) = Array("No", "收货日期", "产品型号", "拉别", "工程师", "数量")
    
16. [A5].Resize(m, 6) = brr
    
17. End Sub

复制代码

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.4.13
   
2.     Dim arr, brr
   
3.     Application.ScreenUpdating = False
   
4.     With Sheets("汇总")
   
5.         rq = Format((.[b3].Value), "yyyy/m/d")
   
6.         .[a5:f10000].ClearContents
   
7.     End With
   
8.     On Error Resume Next
   
9.     ReDim brr(1 To 10000, 1 To 6)
   
10.     b = [{99,12,9,16,18,4}]
    
11.     m = 0
    
12.     With Sheets("数据源")
    
13.         .AutoFilterMode = False
    
14.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
15.         arr = .[a1].Resize(r, 26)
    
16.         For i = 2 To UBound(arr)
    
17.             rq1 = Format(arr(i, 12), "yyyy/m/d")
    
18.             If rq1 = rq Then
    
19.                 m = m + 1
    
20.                 brr(m, 1) = m
    
21.                 For j = 2 To UBound(b)
    
22.                     brr(m, j) = arr(i, b(j))
    
23.                 Next
    
24.             End If
    
25.         Next
    
26.     End With
    
27.     With Sheets("汇总")
    
28.         .[a5].Resize(m, 6) = brr
    
29.     End With
    
30.     Application.ScreenUpdating = True
    
31.     MsgBox "OK！"
    
32. End Sub
    

复制代码

swl4561255

1. Sub test()
   
2. Range("A4:F100").ClearContents
   
3. ar = Sheets("数据源").Range("A1").End(4).Row
   
4. arr = Sheets("数据源").Range("A2:R" & ar)
   
5. Dim brr(1 To 100, 1 To 6)
   
6. myr = Array(12, 9, 16, 18, 4)
   
7. For i = 1 To ar - 1
   
8.     If Int(arr(i, 12)) = [B3] Then
   
9.         m = m + 1
   
10.         brr(m, 1) = m
    
11.         For j = 2 To 6
    
12.             brr(m, j) = arr(i, myr(j - 2))
    
13.         Next
    
14.     End If
    
15. Next
    
16. If m = 0 Then
    
17.    MsgBox "未找到该日期对应的数据！"
    
18.    Exit Sub
    
19. End If
    
20. [A4].Resize(1, 6) = Array("No", "收货日期", "产品型号", "拉别", "工程师", "数量")
    
21. [A5].Resize(m, 6) = brr
    
22. End Sub

复制代码

代码优化了一下。

天真无鞋

非常感谢2位老师，还有一个小小的问题，请教一下，当引用到相同产品型号的时候，当日的数据能否求和，参考下图，谢谢！

天真无鞋

swl4561255 发表于 2024-4-13 18:04
代码优化了一下。

谢谢老师，还有一个小问题如果有时间帮忙看看，参考下图：

天真无鞋

天真无鞋 发表于 2024-4-13 18:25
谢谢老师，还有一个小问题如果有时间帮忙看看，参考下图：

第二个图粘贴的时候搞错了

鄂龙蒙

vba-统计.rar (36.75 KB, 下载次数: 6)

2024-4-13 18:40 上传

点击文件名下载附件

天真无鞋

鄂龙蒙 发表于 2024-4-13 18:40

谢谢，能否帮忙加一个计算，谢谢！