设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 菜鸟跨表写明细求和
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 1156|回复: 7

[已解决]菜鸟跨表写明细求和

[复制链接]
xsyexcel
发表于 2021-11-9 09:52 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
有2-10月明细，要求在汇总表，求出所有人员每月工资（每月姓名有变化），请求大神帮助，谢谢
最佳答案
月排行榜 / 总排行榜
心正意诚身修
2021-11-9 11:59
  1.     Sub 汇总()
  2.     Dim ARR(), I As Integer, K As Integer, D, BRR, L As Integer, M As Integer, W, X
  3.     Set D = CreateObject("SCRIPTING.DICTIONARY")
  4.     ReDim ARR(1 To 1000, 1 To Worksheets.Count + 1)
  5.     Range("A3:X1000").Clear
  6.     For I = 1 To Worksheets.Count - 1
  7.         W = Application.WorksheetFunction.Match("累计", Worksheets(I).Range("A2:X2"), 0)
  8.         K = Sheets(I).Range("A65536").End(xlUp).Row
  9.         BRR = Sheets(I).Range("A3:Z" & K)
  10.         For L = 1 To K - 3
  11.         If BRR(L, 2) = "" Then
  12.          L = L + 1
  13.         End If
  14.         If Not D.EXISTS(BRR(L, 2)) Then
  15.             M = M + 1
  16.             D(BRR(L, 2)) = M
  17.             ARR(M, 1) = BRR(L, 2)
  18.             ARR(M, I + 1) = BRR(L, W)
  19.         Else
  20.             ARR(D(BRR(L, 2)), I + 1) = BRR(L, W)
  21.         End If
  22.         Next
  23.         Erase BRR
  24.        Next
  25.     Range("A2").Resize(M, I) = ARR
  26.     Range("A" & M + 2) = "合计"
  27.     For X = 2 To I
  28.       Cells(M + 2, X) = Application.Sum(Cells(2, X).Resize(M, 1))
  29.     Next
  30.     Range("A2").CurrentRegion.Borders.LineStyle = xlContinuous
  31.     End Sub
  32.    
复制代码

求助21.2-10.zip

27.64 KB, 下载次数: 14
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
发表于 2021-11-9 10:57 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
  1.     Sub 汇总()
  2.     Dim ARR(), I As Integer, K As Integer, D, BRR, L As Integer, M As Integer, W
  3.     Set D = CreateObject("SCRIPTING.DICTIONARY")
  4.     ReDim ARR(1 To 1000, 1 To Worksheets.Count + 1)
  5.     Range("A3:X1000").Clear
  6.     For I = 1 To Worksheets.Count - 1
  7.         W = Application.WorksheetFunction.Match("累计", Worksheets(I).Range("A2:X2"), 0)
  8.         K = Sheets(I).Range("A65536").End(xlUp).Row
  9.         BRR = Sheets(I).Range("A4:Z" & K)
  10.         For L = 1 To K - 3
  11.         If Not D.EXISTS(BRR(L, 2)) Then
  12.             M = M + 1
  13.             D(BRR(L, 2)) = M
  14.             ARR(M, 1) = BRR(L, 2)
  15.             ARR(M, I + 1) = BRR(L, W)
  16.         Else
  17.             ARR(D(BRR(L, 2)), I + 1) = BRR(L, W)
  18.         End If
  19.         Next
  20.         Erase BRR
  21.        Next
  22.     Range("A2").Resize(M, I) = ARR
  23.     Range("A2").CurrentRegion.Borders.LineStyle = xlContinuous
  24.     End Sub
  25.    
复制代码

求助21.2-10.rar

30.66 KB, 下载次数: 6
回复

使用道具 举报

xsyexcel
 楼主| 发表于 2021-11-9 11:02 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
心正意诚身修 发表于 2021-11-9 10:57

感 谢，我宏还是学不会
回复

使用道具 举报

发表于 2021-11-9 11:09 | 显示全部楼层
xsyexcel 发表于 2021-11-9 11:02
感 谢，我宏还是学不会

是的。这个我也是用了一个月的时间才入的门。比其他入门时间要长

评分

参与人数 1学分 +2 收起 理由
xsyexcel + 2

查看全部评分

回复

使用道具 举报

xsyexcel
 楼主| 发表于 2021-11-9 11:15 | 显示全部楼层
心正意诚身修 发表于 2021-11-9 10:57

大神，结果好像不对，其中第一个人找不到，合计数到在汇总表里，麻烦再帮我弄弄，再来一个公式，让我再学学
回复

使用道具 举报

发表于 2021-11-9 11:24 | 显示全部楼层
本帖最后由 心正意诚身修 于 2021-11-9 11:45 编辑
xsyexcel 发表于 2021-11-9 11:15
大神，结果好像不对，其中第一个人找不到，合计数到在汇总表里，麻烦再帮我弄弄，再来一个公式，让我再学 ...

公式 你把名字放上去。SUMIF+INDIRECT就可以了。你不会是想用公式在多表去重吧。。。还能自动更新吧。。那公式。也能实现。。就是。。。一般没人愿意动手。
回复

使用道具 举报

发表于 2021-11-9 11:59 | 显示全部楼层    本楼为最佳答案   
  1.     Sub 汇总()
  2.     Dim ARR(), I As Integer, K As Integer, D, BRR, L As Integer, M As Integer, W, X
  3.     Set D = CreateObject("SCRIPTING.DICTIONARY")
  4.     ReDim ARR(1 To 1000, 1 To Worksheets.Count + 1)
  5.     Range("A3:X1000").Clear
  6.     For I = 1 To Worksheets.Count - 1
  7.         W = Application.WorksheetFunction.Match("累计", Worksheets(I).Range("A2:X2"), 0)
  8.         K = Sheets(I).Range("A65536").End(xlUp).Row
  9.         BRR = Sheets(I).Range("A3:Z" & K)
  10.         For L = 1 To K - 3
  11.         If BRR(L, 2) = "" Then
  12.          L = L + 1
  13.         End If
  14.         If Not D.EXISTS(BRR(L, 2)) Then
  15.             M = M + 1
  16.             D(BRR(L, 2)) = M
  17.             ARR(M, 1) = BRR(L, 2)
  18.             ARR(M, I + 1) = BRR(L, W)
  19.         Else
  20.             ARR(D(BRR(L, 2)), I + 1) = BRR(L, W)
  21.         End If
  22.         Next
  23.         Erase BRR
  24.        Next
  25.     Range("A2").Resize(M, I) = ARR
  26.     Range("A" & M + 2) = "合计"
  27.     For X = 2 To I
  28.       Cells(M + 2, X) = Application.Sum(Cells(2, X).Resize(M, 1))
  29.     Next
  30.     Range("A2").CurrentRegion.Borders.LineStyle = xlContinuous
  31.     End Sub
  32.    
复制代码

评分

参与人数 1学分 +2 收起 理由
xsyexcel + 2 学习了

查看全部评分

回复

使用道具 举报

xsyexcel
 楼主| 发表于 2021-11-9 12:03 | 显示全部楼层
心正意诚身修 发表于 2021-11-9 11:59

谢谢大神，
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-5-3 14:02 , Processed in 0.342566 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表