[已解决]求一个条件格式的代码

lzclzch

求一个条件格式的代码
在此谢谢

最佳答案

月排行榜 / 总排行榜

兰色幻想

2011-7-24 15:50

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column < 5 And Target.Column > 8 Then Exit Sub
Dim m, n, o, p, x, v
Dim arr
Target.Interior.ColorIndex = xlNone
arr = Range("j3:x" & Range("j65536").End(xlUp).Row)
For x = 1 To UBound(arr)
    If Cells(Target.Row, 3) >= arr(x, 1) And Cells(Target.Row, 3) <= arr(x, 2) And Cells(Target.Row, 4) = arr(x, 3) Then
      m = arr(x, Choose(Target.Column - 5, 4, 8, 12))
      n = arr(x, Choose(Target.Column - 5, 5, 9, 13))
      o = arr(x, Choose(Target.Column - 5, 6, 10, 14))
      p = arr(x, Choose(Target.Column - 5, 7, 11, 15))
     End If
Next x
v = Target.Value
If v < n And v > o Then
  Target.Interior.ColorIndex = 6
ElseIf v < m Or v > p Then
   Target.Interior.ColorIndex = 3
End If
If Target = "" Then Target.Interior.ColorIndex = xlNone
End Sub

跳转到最佳答案楼层

yh0825

楼主的这个的确是很复杂的，不同的时间，不同的品种，数字的变色规则不同，比如
1月9日        N        7        732   品种为N时，为白色，但品种如为M时，则为黄色。
这还只是直径，还有边长、厚度，都是这样的，可能因为时间不同而颜色不同（因为有一个标准修改的时间问题），好复杂的！

兰色幻想

你上传个文件也不说问题在哪？还有你的条件重写一次吧。和你折腾了几十楼，还是你没有把填充颜色的条件说清楚有关系
1 什么条件无色
2 什么条件黄色
3 什么条件红色

兰色幻想

你自已来修改吧：
v是正在编辑的值, n,o,m,p是四个代码相对列的值（n就是n列的，o是o列的。。。。），怎么样设置大小关系你自已改吧
If v < n And v > o Then   ‘黄色单元格的条件
  Target.Interior.ColorIndex = 6  
ElseIf v < m Or v > p Then  ‘红色单元格的条件
   Target.Interior.ColorIndex = 3

兰色幻想

你能不能把话说清楚，什么黄色区域不显示，要举一个例子才行？
我看了你好多问题，都是对问题描述的含含糊糊，你得说清楚，问题才能更快解决。

lzclzch

兰色幻想 发表于 2011-7-24 16:07
你能不能把话说清楚，什么黄色区域不显示，要举一个例子才行？
我看了你好多问题，都是对问题描述的含含糊 ...

忘了上传附件了

兰色幻想

我问你的还没回复呢103填充的规划是啥？

lzclzch

兰色幻想 发表于 2011-7-24 15:50
我问你的还没回复呢103填充的规划是啥？

是我看错品种了
版主是不是黄色区域判定不来，现在附件的数据都是黄色区域的单元格不能显示黄色

兰色幻想

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column < 5 And Target.Column > 8 Then Exit Sub
Dim m, n, o, p, x, v
Dim arr
Target.Interior.ColorIndex = xlNone
arr = Range("j3:x" & Range("j65536").End(xlUp).Row)
For x = 1 To UBound(arr)
    If Cells(Target.Row, 3) >= arr(x, 1) And Cells(Target.Row, 3) <= arr(x, 2) And Cells(Target.Row, 4) = arr(x, 3) Then
      m = arr(x, Choose(Target.Column - 5, 4, 8, 12))
      n = arr(x, Choose(Target.Column - 5, 5, 9, 13))
      o = arr(x, Choose(Target.Column - 5, 6, 10, 14))
      p = arr(x, Choose(Target.Column - 5, 7, 11, 15))
     End If
Next x
v = Target.Value
If v < n And v > o Then
  Target.Interior.ColorIndex = 6
ElseIf v < m Or v > p Then
   Target.Interior.ColorIndex = 3
End If
If Target = "" Then Target.Interior.ColorIndex = xlNone
End Sub

lzclzch

兰色幻想 发表于 2011-7-24 15:34
103不是正在标准范围内吗？95~105

把数据删除出现这个提示
点击单元格马上变红色后让填入数值后也不会变色