VBA跨工作簿提取不重复值及数据汇总

shiruiqiang

了却无痕 发表于 2023-12-31 06:53
顶帖 希望有大神帮忙看看剩下的装运采的分类汇总

你的随机数，自己验算一下

shiruiqiang

要有合计，再加几句

了却无痕

shiruiqiang 发表于 2023-12-31 08:42
你的随机数，自己验算一下

大神晚上好 请问一下能否在此基础上再加上一个功能？

提取2024年运输请款单1-12个工作表中的A列不重复品名转成报表-运输数据的第2行、第18行、第34行的名称

shiruiqiang

了却无痕 发表于 2023-12-31 20:43
大神晚上好 请问一下能否在此基础上再加上一个功能？

提取2024年运输请款单1-12个工作表中的A列不重复 ...

里面有各种不一样的状况，如当月反复记账等
一次性解决

ykcbf1100

2024年第一天，完成运输数据表的汇总统计。

1. Sub ykcbf2()  '//2024.1.1
   
2.     Dim arr, brr, d
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Set sh = ThisWorkbook.Sheets("运输数据")
   
7.     p = ThisWorkbook.Path
   
8.     f = p & "\2024年运输请款单.xlsx"
   
9.     Set wb = Workbooks.Open(f, 0)
   
10.     For Each sht In wb.Sheets
    
11.         If Val(sht.Name) Then
    
12.             With sht
    
13.                 yf = sht.Name & "月"
    
14.                 r = .UsedRange.Find("请款方").Row - 4
    
15.                 arr = .Range("a1:k" & r)
    
16.                 For i = 4 To UBound(arr)
    
17.                     For j = 2 To 4
    
18.                         s = yf & "|" & arr(i, 1) & "|" & Trim(arr(3, j))
    
19.                         d(s) = Val(arr(i, j))
    
20.                     Next
    
21.                 Next
    
22.             End With
    
23.         End If
    
24.     Next
    
25.     wb.Close False
    
26.     With sh
    
27.         arr = .[a1:m48]
    
28.         For i = 1 To UBound(arr) Step 16
    
29.             st = Left(Trim(arr(i, 1)), 1)
    
30.             For j = 2 To UBound(arr, 2)
    
31.                 Sum = 0
    
32.                 For x = 3 To 14
    
33.                     s = arr(i + x - 1, 1) & "|" & arr(i + 1, j) & "|" & st
    
34.                     If d.exists(s) Then
    
35.                         arr(i + x - 1, j) = d(s)
    
36.                     Else
    
37.                         arr(i + x - 1, j) = 0
    
38.                     End If
    
39.                     Sum = Sum + arr(i + x - 1, j)
    
40.                 Next
    
41.                 arr(i + 14, j) = Sum
    
42.             Next
    
43.         Next
    
44.         .[a1:m48] = arr
    
45.     End With
    
46.     Set d = Nothing
    
47.     Application.ScreenUpdating = True
    
48.     MsgBox "OK！"
    
49. End Sub
    
50. 
    

复制代码

ykcbf1100

2024年第一天，完成运输数据表的汇总统计。

附件供参考。。。

了却无痕

shiruiqiang 发表于 2024-1-1 11:57
里面有各种不一样的状况，如当月反复记账等
一次性解决

求和代码是我哪里抄得不对吗？

表格显示的居然是这个东东
我觉得上次的表格还欠缺了一个列汇总，不知大神能否可以按照提取品名最后一列+1为汇总列的思路加进代码里面做横纵汇总呢？

了却无痕

ykcbf1100 发表于 2024-1-1 14:46
2024年第一天，完成运输数据表的汇总统计。

附件供参考。。。

大神  我报表的品名并不是完整的 您看能在代码中能调整一下吗？
1.提取不重复唯一的名称
2.提取不重复唯一名称的最后一列+1为列汇总（月份数据的汇总）
3.行汇总（品名数据的汇总）
要求有点多

ykcbf1100

了却无痕 发表于 2024-1-1 15:41
大神  我报表的品名并不是完整的 您看能在代码中能调整一下吗？
1.提取不重复唯一的名称
2.提取不重复 ...

就原附件而言，代码就不用修改了。
如果你增加新的需求，可以上传附件。

了却无痕

ykcbf1100 发表于 2024-1-1 15:54
就原附件而言，代码就不用修改了。
如果你增加新的需求，可以上传附件。

感觉挺难的 不确定能否实现
1.不重复名称提取到行
2.分类汇总数据
3.横纵汇总

还请大神看看呀