多条件汇总+提取不重复名称

wuailantian

各位走过路过的大神 请点进来看看


1.想要在报表工作簿的机械表中 按数据表中的施工单位、月份做一个工时和数量的汇总
2.根据数据源应收应付试用版 按公司名称整一个总单出来

wang-way

用字典 分类 累加一下

ykcbf1100

大辉机械和驰辉机械是不是同一个单位啊，一个只有收入，一个只有支出。

ykcbf1100

看了半天没看明白，也不知道大机小机怎么来的，也看不出来收入、支出、利润怎么来的。

wuailantian

ykcbf1100 发表于 2024-1-9 08:21
看了半天没看明白，也不知道大机小机怎么来的，也看不出来收入、支出、利润怎么来的。

报告大神  目前想要求图片框出来的这几个部分 ，数据源就是数据表中的机械 ，根据机械台班的施工单位 按月汇总

至于您说的收入、支出以及利润 都是从下面分表带上去的

wuailantian

ykcbf1100 发表于 2024-1-9 08:15
大辉机械和驰辉机械是不是同一个单位啊，一个只有收入，一个只有支出。

是的 应该是我文件没改好

wuailantian

wang-way 发表于 2024-1-8 22:34
用字典 分类 累加一下

说出来就挺不好意思的 我目前的水平停留在只认识字典

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.1.9
   
2.     Application.ScreenUpdating = False
   
3.     p = ThisWorkbook.Path
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     f = p & "\数据源.xlsx"
   
6.     Set Sh = ThisWorkbook.Sheets("机械租赁利润表")
   
7.     Set Wb = Workbooks.Open(f, 0)
   
8.     With Wb.Sheets("机械")
   
9.         r = .Cells(Rows.Count, 1).End(3).Row
   
10.         arr = .Range("a3:o" & r)
    
11.         Wb.Close False
    
12.     End With
    
13.     For i = 2 To UBound(arr)
    
14.         s = arr(i, 2) & "|" & Month(arr(i, 4))
    
15.         If Not d.exists(s) Then
    
16.             d(s) = Array(arr(i, 6), arr(i, 9))
    
17.         Else
    
18.             t = d(s)
    
19.             t(0) = t(0) + arr(i, 6)
    
20.             t(1) = t(1) + arr(i, 9)
    
21.             d(s) = t
    
22.         End If
    
23.     Next
    
24.     With Sh
    
25.         arr = .Range("a20:e33")
    
26.         For j = 2 To UBound(arr, 2) Step 2
    
27.             For i = 3 To UBound(arr)
    
28.                 s = arr(1, j) & "|" & Val(arr(i, 1))
    
29.                 If d.exists(s) Then
    
30.                     arr(i, j) = d(s)(0)
    
31.                     arr(i, j + 1) = d(s)(1)
    
32.                 End If
    
33.             Next
    
34.         Next
    
35.         .Range("a20:e33") = arr
    
36.         .[b34].Resize(1, 4).FormulaR1C1 = "=SUM(R22C:R" & "[-1]C)"
    
37.     End With
    
38.     Application.ScreenUpdating = True
    
39.     MsgBox "OK！"
    
40. End Sub
    
41. 
    

复制代码

ykcbf1100

wuailantian 发表于 2024-1-9 08:50
说出来就挺不好意思的 我目前的水平停留在只认识字典

附件供参考。。。

wuailantian

ykcbf1100 发表于 2024-1-9 09:23
附件供参考。。。

大神 可以再给看看另一个压缩包里的另一表吗？