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

兰色幻想

用这样的代码就可以了：

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 5 And Target.Column > 8 Then Exit Sub
Dim m, n, o, p, x, v
Dim arr
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
End Sub

lzclzch

兰色幻想 发表于 2011-7-24 13:03
用这样的代码就可以了：

Private Sub Worksheet_Change(ByVal Target As Range)

你好版主
这个代码还是通不过

兰色幻想

怎么通不过了？

liwenhong

兰色幻想 发表于 2011-7-24 15:50
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column < 5 And  ...

也是有一个条件格式的问题，麻烦看看，帮助解决，先谢谢了！问题地址是：http://www.excelpx.com/forum.php?mod=viewthread&tid=335197&page=1&extra=#pid3803148