Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 763|回复: 29

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

[复制链接]
发表于 2017-6-3 13:49 | 显示全部楼层 |阅读模式
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
本帖最后由 网络人 于 2017-6-3 16:00 编辑

具体要求见附件

工作簿2.rar

9.73 KB, 下载次数: 35

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

  2. Application.ScreenUpdating = False
  3. Application.DisplayAlerts = False

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

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


发表于 2017-6-3 13:56 | 显示全部楼层
1.是不是只有2个sheet  一个公司,一个内部
2.表格是不是都是按照月份统计的,会不会出现4月和5月混合在一张表里面的情况
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-6-3 14:01 | 显示全部楼层
chart888 发表于 2017-6-3 13:56
1.是不是只有2个sheet  一个公司,一个内部
2.表格是不是都是按照月份统计的,会不会出现4月和5月混合在一 ...

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

回复 支持 反对

使用道具 举报

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

好的  明白了
回复 支持 反对

使用道具 举报

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

  2. Application.ScreenUpdating = False
  3. Application.DisplayAlerts = False

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

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

工作簿2.zip

20.64 KB, 下载次数: 13

回复 支持 反对

使用道具 举报

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

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

使用道具 举报

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

  2. Application.ScreenUpdating = False
  3. Application.DisplayAlerts = False

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

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


工作簿2.zip

74.35 KB, 下载次数: 33

回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-6-3 16:00 | 显示全部楼层
回复 支持 反对

使用道具 举报

发表于 2017-6-3 16:03 | 显示全部楼层

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

使用道具 举报

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

谢谢提醒!怎么样才能学到你这样的水准了?
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2017-8-23 10:23 , Processed in 0.109200 second(s), 27 queries , Gzip On, Memcache On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

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