[已解决]求助大神帮忙写一个VBA代码！！

guo_zhan11

请大神帮忙写一个VBA代码将各月明细分别汇总到各个汇总表中！！谢谢！！

最佳答案

月排行榜 / 总排行榜

grf1973

2017-6-6 15:11

做了一个应发工资的，其他的在此基础上稍微改一下即可。

1. Sub 应发工资()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     For k = 1 To 12
   
5.         With Sheets(k & "月")
   
6.             m = .[a1:z3].Find("姓名").Column
   
7.             c = .[a1:z3].Find("应发工资").Column
   
8.             r = .[a1:z3].Find("姓名").Row
   
9.             arr = .[a1].CurrentRegion
   
10.             For i = r + 1 To UBound(arr)
    
11.                 x = arr(i, m)
    
12.                 If x <> "" And x <> "合计" Then
    
13.                     d1(x) = ""
    
14.                     xx = .Name & x
    
15.                     d(xx) = d(xx) + arr(i, c)
    
16.                 End If
    
17.             Next
    
18.         End With
    
19.     Next
    
20.     With Sheets("应发数汇总")
    
21.         .[a3:o10000] = ""
    
22.         .[b3].Resize(d1.Count) = Application.Transpose(d1.keys)
    
23.         arr = .[a1].CurrentRegion
    
24.         For i = 3 To UBound(arr)
    
25.             arr(i, 1) = i - 2
    
26.             x = arr(i, 2): s = 0
    
27.             For j = 3 To 14
    
28.                 arr(i, j) = d(arr(2, j) & x)
    
29.                 s = s + arr(i, j)
    
30.             Next
    
31.             arr(i, j) = s
    
32.         Next
    
33.         .[a1].CurrentRegion = arr
    
34.     End With
    
35. End Sub

复制代码

跳转到最佳答案楼层

chart888

你每个月的表格格式好像都不一样
如果一样的话可能更好处理点

guo_zhan11

chart888 发表于 2017-6-2 18:13
你每个月的表格格式好像都不一样
如果一样的话可能更好处理点

但大致都差不多的！如果用公式有点麻烦，所以来求助高手帮忙写段代码！

QCW911

差不多可不行，要一样，或者有规律可寻。才可以写vba

guo_zhan11

QCW911 发表于 2017-6-5 08:58
差不多可不行，要一样，或者有规律可寻。才可以写vba

老师，也就是每张表的列内容必须一样，如第一列姓名、第二列岗位工资、第三列薪级工资，都以这个顺序吗？

grf1973

做了一个应发工资的，其他的在此基础上稍微改一下即可。

1. Sub 应发工资()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     For k = 1 To 12
   
5.         With Sheets(k & "月")
   
6.             m = .[a1:z3].Find("姓名").Column
   
7.             c = .[a1:z3].Find("应发工资").Column
   
8.             r = .[a1:z3].Find("姓名").Row
   
9.             arr = .[a1].CurrentRegion
   
10.             For i = r + 1 To UBound(arr)
    
11.                 x = arr(i, m)
    
12.                 If x <> "" And x <> "合计" Then
    
13.                     d1(x) = ""
    
14.                     xx = .Name & x
    
15.                     d(xx) = d(xx) + arr(i, c)
    
16.                 End If
    
17.             Next
    
18.         End With
    
19.     Next
    
20.     With Sheets("应发数汇总")
    
21.         .[a3:o10000] = ""
    
22.         .[b3].Resize(d1.Count) = Application.Transpose(d1.keys)
    
23.         arr = .[a1].CurrentRegion
    
24.         For i = 3 To UBound(arr)
    
25.             arr(i, 1) = i - 2
    
26.             x = arr(i, 2): s = 0
    
27.             For j = 3 To 14
    
28.                 arr(i, j) = d(arr(2, j) & x)
    
29.                 s = s + arr(i, j)
    
30.             Next
    
31.             arr(i, j) = s
    
32.         Next
    
33.         .[a1].CurrentRegion = arr
    
34.     End With
    
35. End Sub

复制代码

guo_zhan11

grf1973 发表于 2017-6-6 15:11
做了一个应发工资的，其他的在此基础上稍微改一下即可。

谢谢！！给我解决一个大问题！！

guo_zhan11

grf1973 发表于 2017-6-6 15:11
做了一个应发工资的，其他的在此基础上稍微改一下即可。

老师，你好，在绩效和养老保险汇总中分别有两栏统计，养老保险中有养老保险和职业年金，绩效中有基础绩效和奖励绩效，请问老师要怎样修改一下代码？

grf1973

只要能看懂，自己就能改。

guo_zhan11

grf1973 发表于 2017-6-8 13:50
只要能看懂，自己就能改。

老师，我是小白！！