Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1894|回复: 5

[已解决]求助用VBA按条件汇总数据并且自动隐藏空白区域

[复制链接]
发表于 2017-8-19 12:42 | 显示全部楼层 |阅读模式
本帖最后由 明日之星 于 2017-8-19 19:52 编辑

求助用VBA按条件汇总数据并且自动隐藏空白区域.zip (49.67 KB, 下载次数: 17)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-8-19 13:25 | 显示全部楼层
  1. Sub aaa()
  2. Dim j&
  3. Application.ScreenUpdating = False
  4. For j = 10 To 63
  5.   If Application.CountA(Cells(5, j).Resize(11)) = 0 Then Columns(j).Hidden = True
  6. Next
  7. Application.ScreenUpdating = True
  8. End Sub
复制代码

评分

参与人数 1 +1 收起 理由
明日之星 + 1 赞一个

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2017-8-19 15:10 | 显示全部楼层

帖子里有二个功能要求,实现了一个“自动隐藏空白列”功能,还有个“多条件分类汇总”功能性未实现,请大神继续赐教,谢谢!
回复

使用道具 举报

发表于 2017-8-19 15:51 | 显示全部楼层    本楼为最佳答案   
  1. Sub bbb()
  2. Dim i&, r&, c&
  3. Application.ScreenUpdating = False
  4. Sheets(2).Select
  5. [j5:bk15] = ""
  6. With Sheets(1)
  7.   For i = 4 To .[b65536].End(3).Row
  8.     r = Columns(2).Find(.Cells(i, 4)).Row + IIf(.Cells(i, 5) = "晚班", 1, 0)
  9.     c = Rows(4).Find(.Cells(i, 13)).Column
  10.     Cells(r, c) = Cells(r, c) + .Cells(i, 9)
  11.   Next i
  12. End With
  13. For j = 10 To 63
  14.   If Application.CountA(Cells(5, j).Resize(11)) = 0 Then Columns(j).Hidden = True
  15. Next
  16. Application.ScreenUpdating = True
  17. End Sub
复制代码

评分

参与人数 1 +1 收起 理由
明日之星 + 1 很给力

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2017-8-19 21:24 | 显示全部楼层

为什么表1加些数据上去就报错了.zip (40.94 KB, 下载次数: 8)
回复

使用道具 举报

发表于 2017-8-21 11:32 | 显示全部楼层
因为有些线号找不到所以出错,修改如下。
  1. Sub bbb()
  2. Dim i&, r&, c&, rng As Range
  3. Application.ScreenUpdating = False
  4. Sheets(2).Select
  5. [j5:bk12] = ""
  6. With Sheets(1)
  7.   For i = 4 To .[b65536].End(3).Row
  8.     Set rng = Columns(2).Find(.Cells(i, 4))
  9.     If Not rng Is Nothing Then
  10.       r = rng.Row + IIf(.Cells(i, 5) = "wanban", 1, 0)
  11.       c = Rows(4).Find(.Cells(i, 13)).Column
  12.       Cells(r, c) = Cells(r, c) + .Cells(i, 9)
  13.     End If
  14.   Next i
  15. End With
  16. For j = 10 To 63
  17.   If Application.CountA(Cells(5, j).Resize(11)) = 0 Then Columns(j).Hidden = True
  18. Next
  19. Application.ScreenUpdating = True
  20. End Sub
复制代码

评分

参与人数 1 +1 收起 理由
明日之星 + 1 很给力

查看全部评分

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 18:25 , Processed in 1.839856 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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