| 
    
     |  | 助けてください。 さん、こんばんわ。 
 >(他のバージョンでは問題ないのですよね。。。)
 他のバージョンだと3つまでしか式が入れられないので完全な形では試せていませんが、3つずつ適用してみたりして試してますが一応不具合はなかったです。
 
 範囲によって該当するインデックスがずれているのが良くないのかもしれないので、範囲ごとに条件式を追加するようにしてみました。
 
 Sub Macro9()
 'ループさせるために配列で処理
 Dim areaA(1 To 3) As String '範囲をあらわす文字列
 Dim s1(1 To 3, 1 To 2)    '条件式の文字列
 Dim II As Long, TP As Long
 '内容をセット
 areaA(1) = "$H$56:$O$456"
 areaA(2) = "$P$56:$P$456"
 areaA(3) = "$Q$56:$X$456"
 '条件式
 s1(1, 1) = "=NOT(EXACT(TRIM($H56),""""))" 'area1 条件1,area2 条件1,area3 条件1
 s1(2, 1) = "=NOT(EXACT(TRIM($P56),""""))" 'area2 条件2,area3 条件2
 s1(3, 1) = "=NOT(EXACT(TRIM($Q56),""""))" 'area3 条件3
 s1(1, 2) = "=EXACT($BB56,0)"       'area1 条件2,area2 条件3,area3 条件4
 s1(2, 2) = "=EXACT($BC56,0)"       'area2 条件4,area3 条件5
 s1(3, 2) = "=EXACT($AA56,$AA$45)"     'area3 条件6
 
 '条件消去
 Cells.FormatConditions.Delete
 '範囲によって式の数=ループの回数を変える
 For JJ = 1 To 3
 With Range(areaA(JJ))
 .Cells(1).Select
 For TP = 1 To 2
 For II = 1 To JJ
 With .FormatConditions.Add(Type:=xlExpression, Formula1:=s1(II, TP))
 .StopIfTrue = False
 If TP = 1 Then
 With .Borders(xlTop)
 .Weight = xlThin
 .LineStyle = xlContinuous
 End With
 Else
 .Interior.ColorIndex = 16
 End If
 End With
 Next
 Next
 End With
 Next
 '
 Erase areaA, s1
 End Sub
 
 試してみてください。
 
 |  |