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

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 多个工作表数据按条件汇总
数据透视表40+个常用小技巧，让你一次学会！
1234下一页
返回列表 发新帖
查看: 7981|回复: 30

[已解决]多个工作表数据按条件汇总

[复制链接]
发表于 2017-6-3 13:49 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 网络人 于 2017-6-3 16:00 编辑

具体要求见附件
最佳答案
月排行榜 / 总排行榜
chart888
2017-6-3 15:29
网络人 发表于 2017-6-3 15:16
非常感谢！我什么时候能学到这样啊。还有一个超级链接的功能没有实现，就是点击”公司“”这个单元格的名 ...
  1. Private Sub CommandButton1_Click()

  3. Application.ScreenUpdating = False
  4. Application.DisplayAlerts = False

  6. Dim wt As Worksheet
  7. Dim i, i1, i2, r, AA As Integer
  8. Dim Arr
  9. Dim regex

  11. Set regex = CreateObject("vbscript.regexp")
  12. regex.Pattern = "\d+"
  13. AA = regex.Execute(Sheets("目录").Cells(1, 1).Value)(0) * 1
  14. Sheets("目录").Range("A3").Resize(10000, 15).Clear
  15. For Each wt In Worksheets
  16.     If wt.Name <> "目录" Then
  17.         r = wt.Range("A65536").End(xlUp).Row
  18.         wt.Cells(r, 5) = WorksheetFunction.Sum(wt.Range(Cells(4, 5).Address, Cells(r - 1, 5).Address))
  19.         wt.Cells(r, 6) = WorksheetFunction.Sum(wt.Range(Cells(4, 6).Address, Cells(r - 1, 6).Address))
  20.         For i1 = 4 To r - 1
  21.             wt.Cells(i1, 7) = wt.Cells(i1 - 1, 7) + wt.Cells(i1, 6) - wt.Cells(i1, 5)
  22.             wt.Cells(r, 7) = wt.Cells(r - 1, 7)
  23.         Next
  24.         BB = regex.Execute(wt.Cells(r, 1).Value)(0) * 1
  25.         i2 = Sheets("目录").Range("B65536").End(xlUp).Row + 1
  26.         If AA = BB Then
  27.             Sheets("目录").Cells(i2, 2) = wt.Name
  28.             Sheets("目录").Cells(i2, 3) = wt.Cells(r, 7)
  29.             Sheets("目录").Cells(i2, 7) = wt.Cells(r, 5)
  30.             Sheets("目录").Cells(i2, 11) = wt.Cells(r, 6)
  31.             Sheets("目录").Cells(i2, 15) = wt.Cells(3, 7)
  32.             ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 2), Address:="", _
  33.             SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 2).Value
  34.         Else
  35.             Sheets("目录").Cells(i2, 2) = wt.Name
  36.             Sheets("目录").Cells(i2, 3) = wt.Cells(r, 7)
  37.             Sheets("目录").Cells(i2, 15) = wt.Cells(3, 7)
  38.             ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 2), Address:="", _
  39.             SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 2).Value
  40.         End If
  41.     End If
  42. Next
  43. i2 = Sheets("目录").Range("B65536").End(xlUp).Row
  44. For i3 = 3 To i2
  45.     Sheets("目录").Cells(i3, 1) = i3 - 2
  46.     Sheets("目录").Cells(i3, 5) = i3 - 2
  47.     Sheets("目录").Cells(i3, 9) = i3 - 2
  48.     Sheets("目录").Cells(i3, 13) = i3 - 2
  49. Next
  50. Application.ScreenUpdating = True
  51. Application.DisplayAlerts = True
  52. End Sub
复制代码


工作表

工作簿2.rar

9.73 KB, 下载次数: 55

相关帖子
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
chart888
发表于 2017-6-3 13:56 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
1.是不是只有2个sheet  一个公司，一个内部
2.表格是不是都是按照月份统计的，会不会出现4月和5月混合在一张表里面的情况
回复

使用道具 举报

 楼主| 发表于 2017-6-3 14:01 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
chart888 发表于 2017-6-3 13:56
1.是不是只有2个sheet  一个公司，一个内部
2.表格是不是都是按照月份统计的，会不会出现4月和5月混合在一 ...

工作表不止2个可能有1-100多个，月份只会存在单月的

回复

使用道具 举报

chart888
发表于 2017-6-3 14:11 | 显示全部楼层
网络人 发表于 2017-6-3 14:01
工作表不止2个可能有1-100多个，月份只会存在单月的

好的  明白了
回复

使用道具 举报

chart888
发表于 2017-6-3 15:05 | 显示全部楼层
本帖最后由 chart888 于 2017-6-3 15:11 编辑
  1. Private Sub CommandButton1_Click()

  3. Application.ScreenUpdating = False
  4. Application.DisplayAlerts = False

  6. Dim wt As Worksheet
  7. Dim i, i1, i2, r, AA As Integer
  8. Dim Arr
  9. Dim regex

  11. Set regex = CreateObject("vbscript.regexp")
  12. regex.Pattern = "\d+"
  13. AA = regex.Execute(Sheets("目录").Cells(1, 1).Value)(0) * 1
  14. Sheets("目录").Range("A3").Resize(10000, 15).ClearContents
  15. For Each wt In Worksheets
  16.     If wt.Name <> "目录" Then
  17.         r = wt.Range("A65536").End(xlUp).Row
  18.         wt.Cells(r, 5) = WorksheetFunction.Sum(wt.Range(Cells(4, 5).Address, Cells(r - 1, 5).Address))
  19.         wt.Cells(r, 6) = WorksheetFunction.Sum(wt.Range(Cells(4, 6).Address, Cells(r - 1, 6).Address))
  20.         For i1 = 4 To r - 1
  21.             wt.Cells(i1, 7) = wt.Cells(i1 - 1, 7) + wt.Cells(i1, 6) - wt.Cells(i1, 5)
  22.             wt.Cells(r, 7) = wt.Cells(r - 1, 7)
  23.         Next
  24.         BB = regex.Execute(wt.Cells(r, 1).Value)(0) * 1
  25.         i2 = Sheets("目录").Range("B65536").End(xlUp).Row + 1
  26.         If AA = BB Then
  27.             Sheets("目录").Cells(i2, 2) = wt.Name
  28.             Sheets("目录").Cells(i2, 3) = wt.Cells(r, 7)
  29.             Sheets("目录").Cells(i2, 7) = wt.Cells(r, 5)
  30.             Sheets("目录").Cells(i2, 11) = wt.Cells(r, 6)
  31.             Sheets("目录").Cells(i2, 15) = wt.Cells(3, 7)
  32.         Else
  33.             Sheets("目录").Cells(i2, 2) = wt.Name
  34.             Sheets("目录").Cells(i2, 3) = wt.Cells(r, 7)
  35.             Sheets("目录").Cells(i2, 15) = wt.Cells(3, 7)
  36.         End If
  37.     End If
  38. Next
  39. i2 = Sheets("目录").Range("B65536").End(xlUp).Row
  40. For i3 = 3 To i2
  41.     Sheets("目录").Cells(i3, 1) = i3 - 2
  42.     Sheets("目录").Cells(i3, 5) = i3 - 2
  43.     Sheets("目录").Cells(i3, 9) = i3 - 2
  44.     Sheets("目录").Cells(i3, 13) = i3 - 2
  45. Next
  46. Application.ScreenUpdating = True
  47. Application.DisplayAlerts = True
  48. End Sub
复制代码

工作簿2.zip

20.64 KB, 下载次数: 25
回复

使用道具 举报

 楼主| 发表于 2017-6-3 15:16 | 显示全部楼层
chart888 发表于 2017-6-3 15:05

非常感谢！我什么时候能学到这样啊。还有一个超级链接的功能没有实现，就是点击”公司“”这个单元格的名称，就跳到“公司“”这个工作表
回复

使用道具 举报

chart888
发表于 2017-6-3 15:29 | 显示全部楼层    本楼为最佳答案   
网络人 发表于 2017-6-3 15:16
非常感谢！我什么时候能学到这样啊。还有一个超级链接的功能没有实现，就是点击”公司“”这个单元格的名 ...
  1. Private Sub CommandButton1_Click()

  3. Application.ScreenUpdating = False
  4. Application.DisplayAlerts = False

  6. Dim wt As Worksheet
  7. Dim i, i1, i2, r, AA As Integer
  8. Dim Arr
  9. Dim regex

  11. Set regex = CreateObject("vbscript.regexp")
  12. regex.Pattern = "\d+"
  13. AA = regex.Execute(Sheets("目录").Cells(1, 1).Value)(0) * 1
  14. Sheets("目录").Range("A3").Resize(10000, 15).Clear
  15. For Each wt In Worksheets
  16.     If wt.Name <> "目录" Then
  17.         r = wt.Range("A65536").End(xlUp).Row
  18.         wt.Cells(r, 5) = WorksheetFunction.Sum(wt.Range(Cells(4, 5).Address, Cells(r - 1, 5).Address))
  19.         wt.Cells(r, 6) = WorksheetFunction.Sum(wt.Range(Cells(4, 6).Address, Cells(r - 1, 6).Address))
  20.         For i1 = 4 To r - 1
  21.             wt.Cells(i1, 7) = wt.Cells(i1 - 1, 7) + wt.Cells(i1, 6) - wt.Cells(i1, 5)
  22.             wt.Cells(r, 7) = wt.Cells(r - 1, 7)
  23.         Next
  24.         BB = regex.Execute(wt.Cells(r, 1).Value)(0) * 1
  25.         i2 = Sheets("目录").Range("B65536").End(xlUp).Row + 1
  26.         If AA = BB Then
  27.             Sheets("目录").Cells(i2, 2) = wt.Name
  28.             Sheets("目录").Cells(i2, 3) = wt.Cells(r, 7)
  29.             Sheets("目录").Cells(i2, 7) = wt.Cells(r, 5)
  30.             Sheets("目录").Cells(i2, 11) = wt.Cells(r, 6)
  31.             Sheets("目录").Cells(i2, 15) = wt.Cells(3, 7)
  32.             ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 2), Address:="", _
  33.             SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 2).Value
  34.         Else
  35.             Sheets("目录").Cells(i2, 2) = wt.Name
  36.             Sheets("目录").Cells(i2, 3) = wt.Cells(r, 7)
  37.             Sheets("目录").Cells(i2, 15) = wt.Cells(3, 7)
  38.             ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 2), Address:="", _
  39.             SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 2).Value
  40.         End If
  41.     End If
  42. Next
  43. i2 = Sheets("目录").Range("B65536").End(xlUp).Row
  44. For i3 = 3 To i2
  45.     Sheets("目录").Cells(i3, 1) = i3 - 2
  46.     Sheets("目录").Cells(i3, 5) = i3 - 2
  47.     Sheets("目录").Cells(i3, 9) = i3 - 2
  48.     Sheets("目录").Cells(i3, 13) = i3 - 2
  49. Next
  50. Application.ScreenUpdating = True
  51. Application.DisplayAlerts = True
  52. End Sub
复制代码


工作簿2.zip

74.35 KB, 下载次数: 55
回复

使用道具 举报

 楼主| 发表于 2017-6-3 16:00 | 显示全部楼层
chart888 发表于 2017-6-3 15:29

太厉害了！
回复

使用道具 举报

chart888
发表于 2017-6-3 16:03 | 显示全部楼层
网络人 发表于 2017-6-3 16:00
太厉害了！

忘了跟你说怎么区分月份了
比如：
目录里面的   5月汇总表  就提取了里面的 5
内部里面的  4月汇总及余数  就提取了里面的4
如果两个是一样的就全部填充
如果不一样的就部分填充
回复

使用道具 举报

 楼主| 发表于 2017-6-3 17:17 | 显示全部楼层
chart888 发表于 2017-6-3 16:03
忘了跟你说怎么区分月份了
比如：
目录里面的   5月汇总表  就提取了里面的 5

谢谢提醒！怎么样才能学到你这样的水准了？
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-4-19 11:03 , Processed in 0.568536 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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