Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
楼主: 网络人

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

[复制链接]
发表于 2017-6-6 15:11 | 显示全部楼层
网络人 发表于 2017-6-6 15:08
第三列和第二列互换位置
  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, BB As Integer
  6. Dim Arr
  7. Dim regex

  8. Set regex = CreateObject("vbscript.regexp")
  9. regex.Pattern = "\d+"
  10. With Sheets("目录")
  11.     AA = regex.Execute(.Cells(1, 1).Value)(0) * 1
  12.     .Range("A3:O" & Rows.Count).ClearContents
  13.     For Each wt In Worksheets
  14.         If wt.Name <> "目录" Then
  15.             r = wt.Range("A65536").End(xlUp).Row
  16.             wt.Cells(r, 5) = WorksheetFunction.Sum(wt.Range(Cells(4, 5).Address, Cells(r - 1, 5).Address))
  17.             wt.Cells(r, 6) = WorksheetFunction.Sum(wt.Range(Cells(4, 6).Address, Cells(r - 1, 6).Address))
  18.             For i1 = 4 To r - 1
  19.                 wt.Cells(i1, 7) = wt.Cells(i1 - 1, 7) + wt.Cells(i1, 6) - wt.Cells(i1, 5)
  20.                 wt.Cells(r, 7) = wt.Cells(r - 1, 7)
  21.             Next
  22.             BB = regex.Execute(wt.Cells(r, 1).Value)(0) * 1
  23.             i2 = .Range("B65536").End(xlUp).Row + 1
  24.             If AA = BB Then
  25.                 .Cells(i2, 1) = i2 - 2
  26.                 .Cells(i2, 3) = wt.Name
  27.                 .Cells(i2, 2) = wt.Cells(r, 7)
  28.                 .Cells(i2, 5) = wt.Cells(r, 5)
  29.                 .Cells(i2, 6) = wt.Cells(r, 6)
  30.                 .Cells(i2, 7) = wt.Cells(3, 7)
  31.                 ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 3), Address:="", _
  32.                 SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 3).Value
  33.             Else
  34.                 .Cells(i2, 1) = i2 - 2
  35.                 .Cells(i2, 3) = wt.Name
  36.                 .Cells(i2, 2) = wt.Cells(r, 7)
  37.                 .Cells(i2, 7) = wt.Cells(3, 7)
  38.                 ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 3), Address:="", _
  39.                 SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 3).Value
  40.             End If
  41.         End If
  42.     Next
  43.     .Cells(i2 + 1, 1) = "合计"
  44.     .Cells(i2 + 1, 3) = WorksheetFunction.Sum(.Range(Cells(3, 3).Address, Cells(i2, 3).Address))
  45.     .Cells(i2 + 1, 5) = WorksheetFunction.Sum(.Range(Cells(3, 5).Address, Cells(i2, 5).Address))
  46.     .Cells(i2 + 1, 6) = WorksheetFunction.Sum(.Range(Cells(3, 6).Address, Cells(i2, 6).Address))
  47.     .Cells(i2 + 1, 7) = WorksheetFunction.Sum(.Range(Cells(3, 7).Address, Cells(i2, 7).Address))
  48.     .Range("A2:G2").EntireColumn.AutoFit
  49.     With .Range("A2").CurrentRegion.Borders
  50.         .LineStyle = xlContinuous
  51.         .Weight = xlThin
  52.     End With
  53.         With .Range("A2").Resize(i2, 7)
  54.             .VerticalAlignment = xlCenter
  55.             .HorizontalAlignment = xlCenter
  56.             .Font.Name = "微软雅黑"
  57.             .Font.Size = 11
  58.         End With
  59. End With

  60. Application.ScreenUpdating = True
  61. Application.DisplayAlerts = True
  62. End Sub
复制代码


工作簿2.zip

70.68 KB, 下载次数: 14

回复

使用道具 举报

 楼主| 发表于 2017-6-6 20:04 | 显示全部楼层
回复

使用道具 举报

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

  •             wt.Cells(r, 5) = WorksheetFunction.Sum(wt.Range(Cells(4, 5).Address, Cells(r - 1, 5).Address))
  •             wt.Cells(r, 6) = WorksheetFunction.Sum(wt.Range(Cells(4, 6).Address, Cells(r - 1, 6).Address))
  •             For i1 = 4 To r - 1
  •                 wt.Cells(i1, 7) = wt.Cells(i1 - 1, 7) + wt.Cells(i1, 6) - wt.Cells(i1, 5)
  •                 wt.Cells(r, 7) = wt.Cells(r - 1, 7)
  • 这个求和如果改成按照单元格日期列的月份来求和数据该怎么样修改代码

回复

使用道具 举报

 楼主| 发表于 2017-6-7 18:06 | 显示全部楼层

那个按单元格日期的月份求和的需要我重新发帖么?
回复

使用道具 举报

 楼主| 发表于 2017-6-7 19:49 | 显示全部楼层
这个地方不准,会导致整个汇总的数据结果不准,怎么样能避免
QQ图片20170607194859.png
回复

使用道具 举报

发表于 2017-6-8 09:18 | 显示全部楼层
网络人 发表于 2017-6-7 19:49
这个地方不准,会导致整个汇总的数据结果不准,怎么样能避免

怎么个不准法
举个例子我看看
回复

使用道具 举报

 楼主| 发表于 2017-6-8 10:16 | 显示全部楼层
chart888 发表于 2017-6-8 09:18
怎么个不准法
举个例子我看看

我的意思是这个地方名称很容被修改,结果就导致前面的数据汇总不准确能否按照日期栏的月份来统计,还有我想将每个表的”6月份汇总及余额:”这个也写入汇总的表内怎么弄,跟余额那样,不受月份限制
回复

使用道具 举报

发表于 2017-6-9 09:56 | 显示全部楼层
学习了
回复

使用道具 举报

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

目录表内能否增加显示红色的排在前面,第二列相同省份的名称排列在一起的代码
回复

使用道具 举报

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

还有一个第4列数据小于0就填充红色,大于或者等于0就不显示填充颜色
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 20:54 , Processed in 0.833421 second(s), 8 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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