关于跨工作表汇总数据问题

jany1312

wdy895 发表于 2024-12-13 15:36
供参考。
用power query汇总后加载数据透视表。你增加月份或者减少月份，只要增加的sheet的格式和前面这几 ...

我们公司还在用07版本的，power query是都没用过

ykcbf1100

VBA，练习一下。

ykcbf1100

练习一下。

1. Sub ykcbf()   '//2024.12.16
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     ReDim brr(1 To 10000, 1 To 100)
   
6.     On Error Resume Next
   
7.     For Each sht In Sheets
   
8.         If Val(sht.Name) Then
   
9.             n = n + 1
   
10.             With sht
    
11.                 r = .Cells(Rows.Count, 1).End(3).Row
    
12.                 r1 = .UsedRange.Find("员工姓名").Row
    
13.                 c1 = .Rows(r1).Find("应发合计").Column
    
14.                 c = .UsedRange.Columns.Count
    
15.                 arr = .Cells(r1, 1).Resize(r - r1 + 1, c)
    
16.             End With
    
17.             For i = 2 To UBound(arr)
    
18.                 s = arr(i, 1)
    
19.                 If Not d.exists(s) Then
    
20.                     m = m + 1
    
21.                     d(s) = m
    
22.                     brr(m, 1) = m
    
23.                     brr(m, 2) = arr(i, 1)
    
24.                 End If
    
25.                 r = d(arr(i, 1))
    
26.                 brr(r, 3) = brr(r, 3) + arr(i, c1)
    
27.                 brr(r, 4) = brr(r, 4) + 1
    
28.             Next
    
29.         End If
    
30.     Next
    
31.     With Sheets("汇总分析")
    
32.         .UsedRange.Offset(1).Clear
    
33.         .Cells.Interior.ColorIndex = 0
    
34.         .[a1].Resize(1, 4).Interior.Color = 49407
    
35.         .Range("c:d").NumberFormatLocal = "0.00"
    
36.         With .[a2].Resize(m, 4)
    
37.             .Value = brr
    
38.             .Borders.LineStyle = 1
    
39.             .HorizontalAlignment = xlCenter
    
40.             .VerticalAlignment = xlCenter
    
41.         End With
    
42.         For i = 1 To m
    
43.             .Cells(i + 1, 4).Value = brr(i, 3) / brr(i, 4)
    
44.         Next
    
45.          .[c2].Resize(m, 2).HorizontalAlignment = xlRight
    
46.     End With
    
47.     Set d = Nothing
    
48.     Application.ScreenUpdating = True
    
49.     MsgBox "OK！"
    
50. End Sub
    

复制代码