[已解决]祝福帮助过我 帮助过别人的 老大们 好人好运 ！根据两个条件自动填充颜色

neicezhanghao

如题 如图 如附件 根据两个条件自动填充颜色  跪求跪求 谢谢 谢谢！！！！
感谢 老大们的 无私帮助！！！

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-6-13 08:45

三种颜色，代码如下：

1. Sub xx()
   
2.     Dim rng As Range
   
3.     Set rng = Sheet1.Range("A13:C35")
   
4.     rng.Interior.ColorIndex = 0
   
5.     If rng(1, 2) >= 3 And rng(1, 3) = "" Then rng(1, 1).Interior.Color = 255
   
6.     If rng(2, 2) >= 3 And rng(2, 3) = "" Then
   
7.         If rng(1, 2) >= 3 And rng(1, 3) = "" Then
   
8.             rng(2, 1).Interior.Color = 1
   
9.         Else
   
10.             rng(2, 1).Interior.Color = 255
    
11.         End If
    
12.     End If
    
13.     For i = 3 To 23
    
14.         If rng(i, 2) >= 3 And rng(i, 3) = "" Then
    
15.             If rng(i - 1, 2) >= 3 And rng(i - 1, 3) = "" Then
    
16.                 If rng(i - 2, 2) >= 3 And rng(i - 2, 3) = "" Then
    
17.                     rng(i, 1).Interior.Color = 16400
    
18.                 Else
    
19.                     rng(i, 1).Interior.Color = 1
    
20.                 End If
    
21.             Else
    
22.                 rng(i, 1).Interior.Color = 255
    
23.             End If
    
24.         End If
    
25.     Next
    
26. End Sub

复制代码

跳转到最佳答案楼层

老司机带带我

验证区域为"A13:C35"，代码如下：

1. Sub xx()
   
2.     Dim rng As Range
   
3.     Set rng = Sheet1.Range("A13:C35")
   
4.     rng.Interior.ColorIndex = 0
   
5.     If rng(1, 2) >= 3 And rng(1, 3) = "" Then rng(1, 1).Interior.Color = 255
   
6.     For i = 2 To 23
   
7.         If rng(i, 2) >= 3 And rng(i, 3) = "" Then
   
8.             If rng(i - 1, 2) >= 3 And rng(i - 1, 3) = "" Then
   
9.                 rng(i, 1).Interior.Color = 1
   
10.             Else
    
11.                 rng(i, 1).Interior.Color = 255
    
12.             End If
    
13.         End If
    
14.     Next
    
15. End Sub

复制代码

爱疯

如果出现连续3行同时满足两个条件，那么A列将如何对应

neicezhanghao

爱疯 发表于 2016-6-12 19:50
如果出现连续3行同时满足两个条件，那么A列将如何对应

三行 还真没考虑  不过也会有 但是不多  不麻烦的话 再上一种颜色 第四行就不考虑了

爱疯

添加3个条件格式
红，=and(b13>=3,c13="")
黑，=and(b12>=3,c12="",b13>=3,c13="")
绿，=and(b11>=3,c11="",b12>=3,c12="",b13>=3,c13="")


1）选择区域后，B13必须是当前单元格。
2）只适用于最多连续3行的情况。

neicezhanghao

爱疯 发表于 2016-6-12 22:05
添加3个条件格式
红，=and(b13>=3,c13="")
黑，=and(b12>=3,c12="",b13>=3,c13="")

超级超级大版主  VBA啊！ 条件格式 不是我要的效果！！！不是真正上色！

雪舞子

示范表见sheet2，测试一下

1. Private Sub Worksheet_Change(ByVal target As Range)
   
2.     If target.Count = 1 Then
   
3.         If target.Column = 2 Or target.Column = 3 Then
   
4.             Const iRow& = 5 '起始行数
   
5.             If target.Row >= iRow Then
   
6.                 If target.Column = 2 Then
   
7.                     clr target, 0
   
8.                 Else
   
9.                     clr target, 1
   
10.                 End If
    
11.             End If
    
12.         End If
    
13.     End If
    
14. End Sub

复制代码

自动上色1.rar (16.25 KB, 下载次数: 9)

2016-6-13 07:48 上传

点击文件名下载附件

老司机带带我

三种颜色，代码如下：

1. Sub xx()
   
2.     Dim rng As Range
   
3.     Set rng = Sheet1.Range("A13:C35")
   
4.     rng.Interior.ColorIndex = 0
   
5.     If rng(1, 2) >= 3 And rng(1, 3) = "" Then rng(1, 1).Interior.Color = 255
   
6.     If rng(2, 2) >= 3 And rng(2, 3) = "" Then
   
7.         If rng(1, 2) >= 3 And rng(1, 3) = "" Then
   
8.             rng(2, 1).Interior.Color = 1
   
9.         Else
   
10.             rng(2, 1).Interior.Color = 255
    
11.         End If
    
12.     End If
    
13.     For i = 3 To 23
    
14.         If rng(i, 2) >= 3 And rng(i, 3) = "" Then
    
15.             If rng(i - 1, 2) >= 3 And rng(i - 1, 3) = "" Then
    
16.                 If rng(i - 2, 2) >= 3 And rng(i - 2, 3) = "" Then
    
17.                     rng(i, 1).Interior.Color = 16400
    
18.                 Else
    
19.                     rng(i, 1).Interior.Color = 1
    
20.                 End If
    
21.             Else
    
22.                 rng(i, 1).Interior.Color = 255
    
23.             End If
    
24.         End If
    
25.     Next
    
26. End Sub

复制代码

l00l00

1. Sub 自动上色()
   
2. Dim i%, j%, Arr, Rng As Range
   
3. Arr = Array(3, 1, 5) '3-红色  1－黑色   5－蓝色
   
4. Set Rng = Range("A13:A35") '行的范围自行修改
   
5. Rng.Interior.ColorIndex = -4142
   
6. For i = Rng.Row To Rng.Row + Rng.Count - 1
   
7.     If Cells(i, 2) > 2 And Cells(i, 3) = "" Then
   
8.         If j < 3 Then
   
9.             Cells(i, 1).Interior.ColorIndex = Arr(j)
   
10.         End If
    
11.         j = j + 1
    
12.     Else
    
13.         j = 0
    
14.     End If
    
15. Next i
    
16. End Sub

复制代码

neicezhanghao

唉！！！一觉醒来这么多代码  真是不好意思 只能选一个 首先诚心的感谢大家！！！虽然我知道 积分经验没什么用 但是你们无私帮助 还是要非常诚心 感谢 谢谢 谢谢 辛苦了！！！好人一生平安 长命百岁 万事如意 功德无量  犹豫老司机带带我 帮我谢了 两个代码 只能 给他了！！！
再说一遍 虽然 积分经验没什么用  但是内心惭愧 只能 诚心的把祝福 送给你们了 我祝福 ： 春风洋溢你们;家人关心你们;爱情滋润你们;财神宠信你们;朋友忠于你们;我会祝福你们;幸运之星永远照着你们!
阿弥陀佛 功德无量！！！！