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

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 按要求填充颜色
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 2801|回复: 7

[已解决]按要求填充颜色

[复制链接]
发表于 2016-7-5 19:09 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 excelpxfans001 于 2016-7-6 09:16 编辑

按要求填充颜色
最佳答案
月排行榜 / 总排行榜
望帝春心
2016-7-6 08:43
参考附件

咨.rar

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

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
发表于 2016-7-5 20:18 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 wanao2008 于 2016-7-5 20:23 编辑

经测试可以满足你的要求：
方法：Sheet1表格里添加”SelectionChange“事件。
代码如下：
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     x = Target.Row
  3.     y = Target.Column
  4.     If Target.Value <> "" Then
  5.         Range("B7:BE9").Interior.Color = xlNone
  6.         Target.Interior.Color = vbYellow
  7.         If Target.Column > 11 And Target.Column < 47 Then
  8.             Range(Target.Offset(0, 1), Target.Offset(0, 11)).Interior.Color = vbYellow
  9.             Range(Target.Offset(0, 1), Target.Offset(0, 10)).Interior.Color = vbRed
  10.             Range(Target.Offset(0, -1), Target.Offset(0, -10)).Interior.Color = vbRed
  11.         ElseIf Target.Column > 46 Then
  12.             If Target.Column = 57 Then
  13.                 Range(Target.Offset(0, -1), Target.Offset(0, -10)).Interior.Color = vbRed
  14.             Else
  15.                 Range(Target.Offset(0, -1), Target.Offset(0, -10)).Interior.Color = vbRed
  16.                 Range(Target.Offset(0, 1), Target.Offset(0, 57 - y)).Interior.Color = vbRed
  17.             End If
  18.         Else
  19.             If Target.Column = 2 Then
  20.                 Range(Target.Offset(0, 1), Target.Offset(0, 10)).Interior.Color = vbRed
  21.             Else
  22.                 Range(Target.Offset(0, 1), Target.Offset(0, 10)).Interior.Color = vbRed
  23.                 Range(Target.Offset(0, -1), Target.Offset(0, 2 - y)).Interior.Color = vbRed
  24.             End If
  25.         
  26.         End If
  27.     End If
  28. End Sub
复制代码
回复

使用道具 举报

发表于 2016-7-5 20:26 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
VBA新手
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2. On Error Resume Next
  3. ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
  4. If Target.Count > 1 Then Exit Sub
  5. If Target.Count = 1 Then
  6. Target.Interior.ColorIndex = 6
  7. Target.Offset(, 11).Interior.ColorIndex = 6
  8. Range(Target.Offset(, -10), Target.Offset(, -1)).Interior.ColorIndex = 3
  9. Range(Target.Offset(, 1), Target.Offset(, 10)).Interior.ColorIndex = 3
  10. End If
  11. End Sub
复制代码

评分

参与人数 3 +71 金币 +20 收起 理由
小小菜鸟学EXCEL + 21 来学习
橘子红 + 30 赞一个
心正意诚身修 + 20 + 20 下次再说不会VBA打死。

查看全部评分

回复

使用道具 举报

发表于 2016-7-5 20:29 | 显示全部楼层
参考附件，启用宏

咨.zip

14.71 KB, 下载次数: 4
回复

使用道具 举报

 楼主| 发表于 2016-7-5 22:52 | 显示全部楼层
望帝春心 发表于 2016-7-5 20:29
参考附件，启用宏

非常感谢老师的解答。只是能否改成不自动的。
选取单元格，运行代码。再填充颜色的。
回复

使用道具 举报

发表于 2016-7-6 08:42 | 显示全部楼层
excelpxfans001 发表于 2016-7-5 22:52
非常感谢老师的解答。只是能否改成不自动的。
选取单元格，运行代码。再填充颜色的。
  1. Sub Greenhand()
  2. On Error Resume Next
  3. With Sheet1
  4.    .Cells.Interior.ColorIndex = xlNone
  5.      ActiveCell.Interior.ColorIndex = 6
  6.      ActiveCell.Offset(, 11).Interior.ColorIndex = 6
  7.    Range(ActiveCell.Offset(, -10), ActiveCell.Offset(, -1)).Interior.ColorIndex = 3
  8.   Range(ActiveCell.Offset(, 1), ActiveCell.Offset(, 10)).Interior.ColorIndex = 3
  9. End With
  10. End Sub
复制代码
回复

使用道具 举报

发表于 2016-7-6 08:43 | 显示全部楼层    本楼为最佳答案   
参考附件

咨.zip

17.73 KB, 下载次数: 4
回复

使用道具 举报

发表于 2016-7-6 08:53 | 显示全部楼层
简化下代码
  1. Sub Greenhand()
  2. On Error Resume Next
  3.    Sheet1.Cells.Interior.ColorIndex = xlNone
  4.    Sheet1.Activate
  5.    With ActiveCell
  6.      .Interior.ColorIndex = 6
  7.      .Offset(, 11).Interior.ColorIndex = 6
  8.    Range(.Offset(, -10), .Offset(, -1)).Interior.ColorIndex = 3
  9.    Range(.Offset(, 1), .Offset(, 10)).Interior.ColorIndex = 3
  10. End With
  11. End Sub
复制代码
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-4-27 07:59 , Processed in 1.033686 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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