项目统计

ykcbf1100

wkxxxr 发表于 2024-6-27 08:46
原本只作项目数统计，还有投资数据等，现补充上去。谢谢！

增加投资项。

ykcbf1100

增加投资项

1. Sub ykcbf()  '//2024.6.27  分类汇总,增加投资项
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("Sheet1")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[a1].Resize(r, 7)
   
7.     End With
   
8.     ReDim brr(1 To UBound(arr), 1 To 9)
   
9.     For j = 2 To UBound(arr, 2) Step 2
   
10.         d.RemoveAll
    
11.         m = 0
    
12.         n = n + 3
    
13.         For i = 3 To UBound(arr)
    
14.             s = arr(i, j)
    
15.             If Not d.exists(s) Then
    
16.                 m = m + 1
    
17.                 d(s) = m
    
18.                 brr(m, n - 2) = s
    
19.                 brr(m, n - 1) = 1
    
20.                 brr(m, n) = arr(i, 7)
    
21.             Else
    
22.                 r = d(s)
    
23.                 brr(r, n - 1) = brr(r, n - 1) + 1
    
24.                 brr(r, n) = brr(r, n) + arr(i, 7)
    
25.             End If
    
26.         Next
    
27.         Max = IIf(Max < m, m, Max)
    
28.     Next
    
29.     With Sheets("Sheet2")
    
30.         .UsedRange.Offset(1).Clear
    
31.         .[a1].Resize(1, 9).Interior.Color = 49407
    
32.         With .[a2].Resize(Max + 1, 9)
    
33.             .Value = brr
    
34.             .Borders.LineStyle = 1
    
35.             .HorizontalAlignment = xlCenter
    
36.             .VerticalAlignment = xlCenter
    
37.         End With
    
38.         r = Max + 1
    
39.         .Cells(r + 1, 1) = "合计"
    
40.         For j = 2 To 9
    
41.             .Cells(r + 1, j) = Application.Sum(.Cells(2, j).Resize(Max))
    
42.         Next
    
43.         ActiveWindow.DisplayZeros = False
    
44.     End With
    
45.     Set d = Nothing
    
46.     Application.ScreenUpdating = True
    
47.     MsgBox "OK！"
    
48. End Sub
    
49. 
    

复制代码

心的启点

ykcbf1100 发表于 2024-6-27 09:14
分类汇总，字典

草爷速度好快

grf1973

。。。。。。。。。。

wang-way

sdytsxd991122 发表于 2024-6-27 09:20

阅读起来  真是费力 你的思维力 MAX

笨鸟飞不高

quqiyuan

参与一下，供参考。。。

LIUZHU

参与下，效果

LIUZHU

JS代码，供参考

1. function 统计(){
   
2.         let arr=Range("a2").CurrentRegion.Value2, len=0;
   
3.         [[1,"l1"],[3,"n1"],[5,"p1"]].forEach(function([a,b]){
   
4.                 let obj=arr.slice(1).reduce((obj,x)=>(obj[x[a]]=(obj[x[a]] || 0)+1,obj),{});
   
5.                 let temp=[[this[a],"计数"]].concat(Object.entries(obj));
   
6.                 Range(b).Resize(temp.length,2).Value2=temp;
   
7.                 len=Math.max(len,temp.length);
   
8.         },arr[0]);
   
9.         let r1=Range("l1").CurrentRegion.Rows.Count+1, fmlr=`=SUM(R[-${len}]C:R[-1]C)`;
   
10.         Cells.Item(r1,12).Resize(1,6).Value2=["合计",fmlr,,fmlr,,fmlr];
    
11. }

复制代码

LIUZHU

附件，WPS打开测试