怎么历遍工作表，然后根据汇总表的字段汇总金额并填入汇总表里

goodlzy

怎么历遍工作表，然后根据汇总表的字段汇总金额并填入汇总表里，汇总表数字字段可以增加和减少，汇总表用户id这一栏是根据工作表表名取值的，姓名一栏取自用户id对应的姓名一栏。如果通过vb实现，求助高手解答。 工作簿1.rar (9.1 KB, 下载次数: 15)

2024-12-23 11:43 上传

点击文件名下载附件

goodlzy

顶起来寻求高手帮忙

z865593849

汇总

ykcbf1100

代码写得比较长，是考虑到分表字段名列号不固定的情况，通用性好一点。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.12.23
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     Set sh = ThisWorkbook.Sheets("汇总表")
   
6.     With sh
   
7.         c1 = .UsedRange.Columns.Count
   
8.         ReDim brr(1 To 10000, 1 To c1)
   
9.         For j = 1 To c1
   
10.             s = .Cells(2, j).Value
    
11.             d1(s) = j
    
12.         Next
    
13.     End With
    
14.     On Error Resume Next
    
15.     For Each sht In Sheets
    
16.         If InStr(sht.Name, sh.Name) = 0 Then
    
17.             With sht
    
18.                 r = .Cells(Rows.Count, 1).End(3).Row
    
19.                 c = .UsedRange.Columns.Count
    
20.                 arr = .[a1].Resize(r, c)
    
21.                 For i = 3 To UBound(arr)
    
22.                     s = arr(i, d1("姓名"))
    
23.                     If Not d.exists(s) Then
    
24.                         m = m + 1
    
25.                         d(s) = m
    
26.                         brr(m, 1) = m
    
27.                         brr(m, 2) = s
    
28.                         For j = 3 To UBound(arr, 2)
    
29.                             s1 = arr(2, j)
    
30.                             If d1.exists(s1) Then
    
31.                                 jj = d1(s1)
    
32.                             End If
    
33.                             brr(m, jj) = arr(i, j)
    
34.                         Next
    
35.                     Else
    
36.                         r = d(s)
    
37.                         For j = 3 To UBound(arr, 2)
    
38.                             s1 = arr(2, j)
    
39.                             If d1.exists(s1) Then
    
40.                                 jj = d1(s1)
    
41.                             End If
    
42.                             brr(r, jj) = brr(r, jj) + arr(i, j)
    
43.                         Next
    
44.                     End If
    
45.                 Next
    
46.             End With
    
47.         End If
    
48.     Next
    
49.     With sh
    
50.         .UsedRange.Offset(2).ClearContents
    
51.         .[a3].Resize(m, c1) = brr
    
52.     End With
    
53.     Set d = Nothing
    
54.     Set d1 = Nothing
    
55.     Application.ScreenUpdating = True
    
56.     MsgBox "OK！"
    
57. End Sub
    
58. 
    

复制代码

goodlzy

ykcbf1100 发表于 2024-12-23 12:25
参与一下。。。

您好，还有一个小问题没实现。汇总表的第一列用户id需要取值于工作表名，因为用户id的值是唯一的，您的公式汇总后是序号。

ykcbf1100

goodlzy 发表于 2024-12-23 13:54
您好，还有一个小问题没实现。汇总表的第一列用户id需要取值于工作表名，因为用户id的值是唯一的，您的公 ...

改好了。。。

重新上传。

goodlzy

ykcbf1100 发表于 2024-12-23 14:06
改好了。。。

文件损坏。。。

goodlzy

完美解决。我自己多看看，多学习。

ykcbf1100

goodlzy 发表于 2024-12-23 14:12
文件损坏。。。

已重新上传。
其实就改一句：brr(m, 1) = .Name