|
何卒、ご教授宜しくお願いいたします。
下記のフォーマットを利用しています。
日付の下に値を入れるのですがJ、K、L列の範囲を超えた場合にセルに色を付けたく思います。
例
100<150 →値が100より大きく150より小さい時は真、そうでなければ偽(色を付ける)
100< →値が100より大きければ真、そうでなければ偽(色を付ける)
という具合で
下記にマクロを実行しましたが
100 <
120 ≦
のようにL列が空欄の場合に旨く動作しません。
何方かご指摘をお願いいたします
A B C・・ J K L・・・Z AA AB AC
1
・
・
9 No 範囲 7/1 7/2 7/3 7/4・・
11 101 100 < 150
12 102 100 <
13 103 < 150
14 104 120 ≦
15 105 80 ≦ 100
16 106 ≦ 120
17 107 150 〜 160
・
・
・
・
・
700
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngCol As Long
Dim lngRow As Long
Dim lngR As Range
With Target
If .Count > 1 Then Exit Sub
If IsEmpty(.Value) Then Exit Sub
If IsNumeric(.Value) = False Then Exit Sub
lngCol = Cells(10, 256).End(xlToLeft).Column
lngRow = Cells(Rows.Count, 26).End(xlUp).Row
Set lngR = Range(Cells(10, 26), Cells(lngRow, lngCol))
If Not Application.Intersect(Target, lngR) Is Nothing Then
Application.EnableEvents = False
.Interior.ColorIndex = xlNone
Select Case Cells(.Row, 11).Value
Case Is = "<"
If Cells(.Row, 12) = "" And .Value <= Cells(.Row, 10).Value Then
.Interior.ColorIndex = 8
Else
.Interior.ColorIndex = xlNone
End If
If Cells(.Row, 10) = "" And .Value >= Cells(.Row, 12).Value Then
.Interior.ColorIndex = 8
Else
.Interior.ColorIndex = xlNone
End If
If .Value <= Cells(.Row, 10).Value Or .Value >= Cells(.Row, 12).Value Then
.Interior.ColorIndex = 8
Else
.Interior.ColorIndex = xlNone
End If
Case Is = "≦"
If Cells(.Row, 10) = "" And .Value > Cells(.Row, 12).Value Then
.Interior.ColorIndex = 8
Else
.Interior.ColorIndex = xlNone
End If
If Cells(.Row, 12) = "" And .Value < Cells(.Row, 10).Value Then
.Interior.ColorIndex = 8
Else
.Interior.ColorIndex = xlNone
End If
If .Value < Cells(.Row, 10).Value Or .Value > Cells(.Row, 12).Value Then
.Interior.ColorIndex = 8
Else
.Interior.ColorIndex = xlNone
End If
Case Is = "〜"
If Cells(.Row, 10) = "" And .Value > Cells(.Row, 12).Value Then
.Interior.ColorIndex = 8
End If
If Cells(.Row, 12) = "" And .Value < Cells(.Row, 10).Value Then
.Interior.ColorIndex = 8
End If
If .Value < Cells(.Row, 10).Value Or .Value > Cells(.Row, 12).Value Then
.Interior.ColorIndex = 8
Else
.Interior.ColorIndex = xlNone
End If
Case Else
.Interior.ColorIndex = xlNone
End Select
End If
Application.EnableEvents = True
End With
End Sub
|
|