分类统计

ddz79101

老师！有表一维想转二维，请老师看看，谢谢

wanghui834

用表格函数做的

ddz79101

wanghui834 发表于 2024-11-10 15:59
用表格函数做的

谢谢老师！成功！收藏了。

shiruiqiang

ykcbf1100

全表自动生成

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.11.10
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     ReDim brr(1 To 10000, 1 To 100)
   
6.     m = 1: n = 1
   
7.     arr = Sheets("汇总").UsedRange
   
8.     brr(1, 1) = arr(1, 2)
   
9.     For i = 2 To UBound(arr)
   
10.         If arr(i, 2) <> Empty Then
    
11.             s = arr(i, 2)
    
12.             If Not d.exists(s) Then
    
13.                 m = m + 1
    
14.                 d(s) = m
    
15.                 brr(m, 1) = s
    
16.             End If
    
17.             r = d(arr(i, 2))
    
18.             s = arr(i, 11)
    
19.             If Not d.exists(s) Then
    
20.                 n = n + 1
    
21.                 d(s) = n
    
22.                 brr(1, n) = s
    
23.             End If
    
24.             c = d(arr(i, 11))
    
25.             brr(r, c) = arr(i, 7)
    
26.         End If
    
27.     Next
    
28.     n = n + 1
    
29.     brr(1, n) = "合计"
    
30.     m = m + 1
    
31.     brr(m, 1) = "合计"
    
32.     With Sheets("结果")
    
33.         .UsedRange.Clear
    
34.         .Cells.Interior.ColorIndex = 0
    
35.         .[a1].Resize(1, n).Interior.Color = 49407
    
36.         .[a2].Resize(m - 1, 1).Interior.Color = 5296274
    
37.         With .[a1].Resize(m, n)
    
38.             .Value = brr
    
39.             .Borders.LineStyle = 1
    
40.             .HorizontalAlignment = xlCenter
    
41.             .VerticalAlignment = xlCenter
    
42.             With .Font
    
43.                 .Name = "微软雅黑"
    
44.                 .Size = 11
    
45.             End With
    
46.         End With
    
47.         For i = 2 To m - 1
    
48.             .Cells(i, n) = Round(Application.Sum(.Cells(i, 2).Resize(, n - 2)), 2)
    
49.         Next
    
50.         For j = 2 To n
    
51.             .Cells(m, j) = Round(Application.Sum(.Cells(3, j).Resize(m - 2)), 2)
    
52.         Next
    
53.     End With
    
54.     Application.ScreenUpdating = True
    
55.     MsgBox "OK！"
    
56. End Sub
    

复制代码

ddz79101

shiruiqiang 发表于 2024-11-10 16:23

谢谢老师！运行成功

ylj518

参与一下，仅供参考，，，

ddz79101

ykcbf1100 发表于 2024-11-10 16:30
全表自动生成

谢谢老师！运行丝滑。我漏了说明一种情况，就是列11的同月份区域且列2的用户名出现多次，金额需向加。即同月同用户金额相加。

ddz79101

ylj518 发表于 2024-11-10 16:44
参与一下，仅供参考，，，

谢谢老师！和你版本不一，Microsoft.ACE.OLEDB.12.0，我这里测不了。