[已解决]多表匯統

dou10801

多表匯總,將相同[編號]的資料統計,敬請各位幫忙,感恩.

最佳答案

月排行榜 / 总排行榜

zjdh

2023-10-9 21:21

是这样吗 評分表2.rar (40.84 KB, 下载次数: 6)

2023-10-9 21:15 上传

点击文件名下载附件

跳转到最佳答案楼层

zjdh

看不懂你要如何汇总？

dou10801

zjdh 发表于 2023-10-8 22:24
看不懂你要如何汇总？

抱歉,沒說清楚,4個工作表,a欄[編號]相同者其他欄(C,D,E,F,H,I,J,K)匯總,謝謝.例:
編號:1=>所要結果...............類推至編號30

編號	姓名	外觀總分（40%）					果肉品質總分（60%）					二者綜合
												（外觀＋果肉品質）
		色澤	蟲害病害	果型	總分	名次	甜度15%	口感25%	果肉色澤20%	總分	名次	總分數	總名次
		20%	10%	10%			甜度	（粗細、香味濃度）	(黑心,花斑)
1	0	70	31	36	138		52	92	72	216
2	0	64	36	32	132		52	80	72	204

uuiu

1. Sub try1()
   
2. Dim d As Object, arr, brr, x As Byte, y As Byte, n As Byte, u As Byte
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheets("匯總").UsedRange.Offset(4, 1).ClearContents
   
5. u = Worksheets.Count
   
6. brr = Sheets("匯總").Range("a1").CurrentRegion
   
7. For n = 1 To u
   
8. arr = Sheets(n).Range("a1").CurrentRegion
   
9. For y = 3 To UBound(arr, 2)
   
10. For x = 5 To UBound(arr)
    
11. 
    
12. If u <> n Then
    
13. Select Case y
    
14. Case 3 To 5, 8 To 10
    
15. d(arr(3, y) & arr(x, 1)) = d(arr(3, y) & arr(x, 1)) + arr(x, y)
    
16. End Select
    
17. End If
    
18. 
    
19. If n = u And y <> 6 Or y <> 11 Then brr(x, y) = d(arr(3, y) & arr(x, 1))
    
20. If n = u And y = 6 Or y = 11 Then brr(x, y) = brr(x, y - 3) + brr(x, y - 2) + brr(x, y - 1)
    
21. 
    
22. Next
    
23. Next
    
24. Next
    
25. 
    
26. Sheets("匯總").UsedRange.Offset(4, 1).ClearContents
    
27. Sheets("匯總").[a1].Resize(UBound(arr), UBound(arr, 2)) = brr
    
28. End Sub

复制代码

好久没用字典了，不知道做得对不对，我这样写汇总的表格要有编号才能汇总

zjdh

是这样吗 評分表2.rar (40.84 KB, 下载次数: 6)

2023-10-9 21:15 上传

点击文件名下载附件