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

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel 技巧操作 › VBA取平均值记数并且标记颜色图表
数据透视表40+个常用小技巧，让你一次学会！
12下一页
返回列表 发新帖
查看: 4127|回复: 12

[已解决]VBA取平均值记数并且标记颜色图表

[复制链接]
发表于 2014-4-21 09:13 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 红尘奇侠 于 2014-4-21 09:43 编辑

已经有大神给做出来了，只是取值没有做小数的后1位处理，这样数据有点多。代码在下面，请大神指点。
  1. Sub Macro1()
  2. Dim arr, d, rng As Range, i&, j%, x&, y&
  3. Set d = CreateObject("scripting.dictionary")
  4. For j = 1 To Sheets.Count
  5.     Sheets(j).Activate
  6.     y = Rows(1).Find("计算平均值").Column
  7.     x = Cells(65536, y).End(xlUp).Row
  8.     arr = Range(Cells(2, y), Cells(x, y))
  9.     Range(Cells(1, y + 2), Cells(65536, "iv")).Clear
  10.     For i = 1 To UBound(arr)
  11.         d(arr(i, 1)) = d(arr(i, 1)) + 1
  12.     Next
  13.     z = Application.Max(d.items) + 1
  14.     Cells(2, y + 2).Resize(d.Count) = Application.Transpose(d.keys)
  15.     Cells(2, y + 2).Resize(d.Count).Sort Cells(2, y + 2)
  16.     Cells(2, y + 2).Resize(d.Count, z).Borders().LineStyle = xlContinuous
  17.     arr = Cells(2, y + 2).CurrentRegion
  18.     For i = 1 To UBound(arr)
  19.         If rng Is Nothing Then
  20.             Set rng = Cells(i + 1, y + 3).Resize(1, d(arr(i, 1)))
  21.         Else
  22.             Set rng = Union(rng, Cells(i + 1, y + 3).Resize(1, d(arr(i, 1))))
  23.         End If
  24.     Next
  25.     If Not rng Is Nothing Then rng.Interior.ColorIndex = 6
  26.     d.RemoveAll
  27.     Set rng = Nothing
  28. Next
  29. End Sub
复制代码
tub.JPG
表格挺好使，只是提取的平均值没有做小数点一位数处理，数字会很多。
一共三个表格都要做。
计算平均值(带按钮).rar (54.73 KB, 下载次数: 11)
平均值

相关帖子

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

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
hwc2ycy
发表于 2014-4-21 09:17 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 hwc2ycy 于 2014-4-21 09:22 编辑

试试round吧。

刚看了下，数值是直接从单元格里取出来的，不如直接设置N列的单元格格式吧。
回复

使用道具 举报

 楼主| 发表于 2014-4-21 09:18 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
hwc2ycy 发表于 2014-4-21 09:17
试试round吧。

应该加在什么位置，代码看不懂。
回复

使用道具 举报

hwc2ycy
发表于 2014-4-21 09:26 | 显示全部楼层
Columns("N").NumberFormatLocal = "0.0"
加在end sub上面。
回复

使用道具 举报

hwc2ycy
发表于 2014-4-21 09:28 | 显示全部楼层
  1. Sub Macro1()
  2.     Dim arr, d, rng As Range, i&, j%, x&, y&
  3.     Application.ScreenUpdating = False
  4.     Set d = CreateObject("scripting.dictionary")
  5.     For j = 1 To Sheets.Count
  6.         Sheets(j).Activate
  7.         y = Rows(1).Find("计算平均值").Column
  8.         x = Cells(65536, y).End(xlUp).Row
  9.         arr = Range(Cells(2, y), Cells(x, y))
  10.         Range(Cells(1, y + 2), Cells(65536, "iv")).Clear
  11.         For i = 1 To UBound(arr)
  12.             d(arr(i, 1)) = d(arr(i, 1)) + 1
  13.         Next
  14.         z = Application.Max(d.items) + 1
  15.         Cells(2, y + 2).Resize(d.Count) = Application.Transpose(d.keys)
  16.         Cells(2, y + 2).Resize(d.Count).Sort Cells(2, y + 2)
  17.         Cells(2, y + 2).Resize(d.Count, z).Borders().LineStyle = xlContinuous
  18.         arr = Cells(2, y + 2).CurrentRegion
  19.         For i = 1 To UBound(arr)
  20.             If rng Is Nothing Then
  21.                 Set rng = Cells(i + 1, y + 3).Resize(1, d(arr(i, 1)))
  22.             Else
  23.                 Set rng = Union(rng, Cells(i + 1, y + 3).Resize(1, d(arr(i, 1))))
  24.             End If
  25.         Next
  26.         If Not rng Is Nothing Then rng.Interior.ColorIndex = 6
  27.         d.RemoveAll
  28.         Set rng = Nothing
  29.     Next
  30.     Columns("N").NumberFormatLocal = "0.0"
  31.     Application.ScreenUpdating = True
  32. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-4-21 09:29 | 显示全部楼层
hwc2ycy 发表于 2014-4-21 09:17
试试round吧。

刚看了下，数值是直接从单元格里取出来的，不如直接设置N列的单元格格式吧。

试了，不好使，单元格里面是公式，他取值也是取的公式得值，不是单纯的取显示的数字。
回复

使用道具 举报

 楼主| 发表于 2014-4-21 09:36 | 显示全部楼层
hwc2ycy 发表于 2014-4-21 09:28

这样只有第三个表是1位数，其他两个还是一样的，第二个表14选6不是N列。
回复

使用道具 举报

hwc2ycy
发表于 2014-4-21 09:40 | 显示全部楼层    本楼为最佳答案   
  1. Sub Macro1()
  2.     Dim arr, d, rng As Range, i&, j%, x&, y&
  3.     Set d = CreateObject("scripting.dictionary")
  4.     For j = 1 To Sheets.Count
  5.         Sheets(j).Activate
  6.         y = Rows(1).Find("计算平均值").Column
  7.         x = Cells(65536, y).End(xlUp).Row
  8.         arr = Range(Cells(2, y), Cells(x, y))
  9.         Range(Cells(1, y + 2), Cells(65536, "iv")).Clear
  10.         For i = 1 To UBound(arr)
  11.             d(arr(i, 1)) = d(arr(i, 1)) + 1
  12.         Next
  13.         Z = Application.Max(d.items) + 1
  14.         Cells(2, y + 2).Resize(d.Count) = Application.Transpose(d.keys)
  15.         Columns(y + 2).NumberFormatLocal = "0.0"
  16.         Cells(2, y + 2).Resize(d.Count).Sort Cells(2, y + 2)
  17.         Cells(2, y + 2).Resize(d.Count, Z).Borders().LineStyle = xlContinuous
  18.         arr = Cells(2, y + 2).CurrentRegion
  19.         For i = 1 To UBound(arr)
  20.             If rng Is Nothing Then
  21.                 Set rng = Cells(i + 1, y + 3).Resize(1, d(arr(i, 1)))
  22.             Else
  23.                 Set rng = Union(rng, Cells(i + 1, y + 3).Resize(1, d(arr(i, 1))))
  24.             End If
  25.         Next
  26.         If Not rng Is Nothing Then rng.Interior.ColorIndex = 6
  27.         d.RemoveAll
  28.         Set rng = Nothing
  29.     Next
  30. End Sub
复制代码
你再试试。
回复

使用道具 举报

 楼主| 发表于 2014-4-21 09:43 | 显示全部楼层
hwc2ycy 发表于 2014-4-21 09:40
你再试试。

帅，解决了，谢谢啦。
回复

使用道具 举报

发表于 2014-4-21 10:14 | 显示全部楼层
本帖最后由 开心妙妙 于 2014-4-21 10:55 编辑
  1. <blockquote>Sub Macro1()
复制代码
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-4-19 22:01 , Processed in 0.500530 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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