Excel精英培训网

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

[已解决]符合要求的单元格填充红色

[复制链接]
发表于 2016-6-10 23:23 | 显示全部楼层 |阅读模式
本帖最后由 excelpxfans001 于 2016-6-11 17:33 编辑

符合要求的单元格填充红色
最佳答案
2016-6-11 13:34
本帖最后由 老司机带带我 于 2016-6-11 13:56 编辑

又改了下,第二行的数据不对
  1. Sub xx()
  2.     Dim rng As Range, x$, y$, rngx As Range
  3.     Set rngx = Sheet1.Range("B10:T17")
  4.     rngx.Interior.ColorIndex = 0
  5.     For Each rng In rngx
  6.     If rng <> "" And rng.Offset(-1, 0) <> "" And rng.Offset(-2, 0) <> "" Then
  7.         If rng.Offset(-1, 0).Value > rng.Value Then
  8.             If rng.Offset(-1, 0).Value - rng.Value <= 5 Then
  9.                 x = "左"
  10.             Else
  11.                 x = "右"
  12.             End If
  13.         Else
  14.             If Abs(rng.Offset(-1, 0).Value - rng.Value) < 5 Then
  15.                 x = "右"
  16.             Else
  17.                 x = "左"
  18.             End If
  19.         End If
  20.         If rng.Offset(-2, 0).Value > rng.Offset(-1, 0).Value Then
  21.             If rng.Offset(-2, 0).Value - rng.Offset(-1, 0).Value <= 5 Then
  22.                 y = "左"
  23.             Else
  24.                 y = "右"
  25.             End If
  26.         Else
  27.             If Abs(rng.Offset(-2, 0).Value - rng.Offset(-1, 0).Value) < 5 Then
  28.                 y = "右"
  29.             Else
  30.                 y = "左"
  31.             End If
  32.         End If
  33.         If x <> y Then rng.Interior.Color = 255
  34.     End If
  35.     Next
  36. End Sub
复制代码

填充红色666.zip

10.15 KB, 下载次数: 11

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2016-6-11 10:53 | 显示全部楼层
  1. Sub xx()
  2.     Dim rng As Range, x$, y$
  3.     Set rng = Selection
  4.     If rng.Count > 1 Then Exit Sub
  5.     If rng.Row < 7 Or rng.Row > 20 Then Exit Sub
  6.     If rng.Column < 2 Or rng.Column > 18 Then Exit Sub
  7.     If rng.Offset(-1, 0) = "" Then Exit Sub
  8.     If rng.Offset(-2, 0) = "" Then Exit Sub
  9.     If rng.Offset(-1, 0).Value > rng.Value Then
  10.         If rng.Offset(-1, 0).Value - rng.Value <= 5 Then
  11.             x = "左"
  12.         Else
  13.             x = "右"
  14.         End If
  15.     Else
  16.         If Abs(rng.Offset(-1, 0).Value - rng.Value) <= 5 Then
  17.             x = "右"
  18.         Else
  19.             x = "左"
  20.         End If
  21.     End If
  22.     If rng.Offset(-2, 0).Value > rng.Offset(-1, 0).Value Then
  23.         If rng.Offset(-2, 0).Value - rng.Offset(-1, 0).Value <= 5 Then
  24.             y = "左"
  25.         Else
  26.             y = "右"
  27.         End If
  28.     Else
  29.         If Abs(rng.Offset(-2, 0).Value - rng.Offset(-1, 0).Value) <= 5 Then
  30.             y = "右"
  31.         Else
  32.             y = "左"
  33.         End If
  34.     End If
  35.     If x <> y Then rng.Interior.Color = 255
  36. End Sub
复制代码

填充红色666.rar

18.75 KB, 下载次数: 8

回复

使用道具 举报

 楼主| 发表于 2016-6-11 11:01 | 显示全部楼层
老司机带带我 发表于 2016-6-11 10:53

运行代码没有反应哦。
回复

使用道具 举报

发表于 2016-6-11 11:28 | 显示全部楼层
本帖最后由 老司机带带我 于 2016-6-11 11:50 编辑

你把所有的颜色都改为无色,选中N14单元格,单击按钮!他是按你选中的单个单元格进行计算的!没有反应的对应单元格就是不符合你规则的! Untitled.gif
回复

使用道具 举报

 楼主| 发表于 2016-6-11 11:52 | 显示全部楼层
老司机带带我 发表于 2016-6-11 11:28
你把所有的颜色都改为无色,选中N14单元格,单击按钮!他是按你选中的单个单元格进行计算的!没有反应的对应 ...

你好老师。不选取单元格,只要是像这样示例这样要求的。都填充红色哦。

填充红色新1.zip

18.41 KB, 下载次数: 6

回复

使用道具 举报

发表于 2016-6-11 12:35 | 显示全部楼层
填充红色新1.rar (20.7 KB, 下载次数: 5)
回复

使用道具 举报

 楼主| 发表于 2016-6-11 13:17 | 显示全部楼层
本帖最后由 excelpxfans001 于 2016-6-11 13:24 编辑
老司机带带我 发表于 2016-6-11 12:35

验证后,有错误哦。

sssss.zip

19.82 KB, 下载次数: 5

回复

使用道具 举报

发表于 2016-6-11 13:34 | 显示全部楼层    本楼为最佳答案   
本帖最后由 老司机带带我 于 2016-6-11 13:56 编辑

又改了下,第二行的数据不对
  1. Sub xx()
  2.     Dim rng As Range, x$, y$, rngx As Range
  3.     Set rngx = Sheet1.Range("B10:T17")
  4.     rngx.Interior.ColorIndex = 0
  5.     For Each rng In rngx
  6.     If rng <> "" And rng.Offset(-1, 0) <> "" And rng.Offset(-2, 0) <> "" Then
  7.         If rng.Offset(-1, 0).Value > rng.Value Then
  8.             If rng.Offset(-1, 0).Value - rng.Value <= 5 Then
  9.                 x = "左"
  10.             Else
  11.                 x = "右"
  12.             End If
  13.         Else
  14.             If Abs(rng.Offset(-1, 0).Value - rng.Value) < 5 Then
  15.                 x = "右"
  16.             Else
  17.                 x = "左"
  18.             End If
  19.         End If
  20.         If rng.Offset(-2, 0).Value > rng.Offset(-1, 0).Value Then
  21.             If rng.Offset(-2, 0).Value - rng.Offset(-1, 0).Value <= 5 Then
  22.                 y = "左"
  23.             Else
  24.                 y = "右"
  25.             End If
  26.         Else
  27.             If Abs(rng.Offset(-2, 0).Value - rng.Offset(-1, 0).Value) < 5 Then
  28.                 y = "右"
  29.             Else
  30.                 y = "左"
  31.             End If
  32.         End If
  33.         If x <> y Then rng.Interior.Color = 255
  34.     End If
  35.     Next
  36. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2016-6-11 13:39 | 显示全部楼层
老司机带带我 发表于 2016-6-11 13:34

谢谢老师,应该是对。我验证下。
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 22:21 , Processed in 0.698440 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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