Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count <= 2500 Then
' Проверка на количество ячеек. Слишком большое количество
' выделенных ячеек замедляет работу, т.к. при выполнении макроса
' определяется адрес каждой выделенной ячейки.
ActiveSheet.Cells.FormatConditions.Delete
Dim RSMin As Integer
Dim CSMin As Integer
Dim RSMax As Integer
Dim CSMax As Integer
' ---------начало блока------------
For Each Target In Selection.Cells
If RSMin = 0 Then RSMin = Target.Row
If CSMin = 0 Then CSMin = Target.Column
If Target.Row < RSMin Then
RSMin = Target.Row
ElseIf Target.Row > RSMax Then
RSMax = Target.Row
End If
If Target.Column < CSMin Then
CSMin = Target.Column
ElseIf Target.Column > CSMax Then
CSMax = Target.Column
End If
Next
'--------конец блока--------------
' определяются максимальные и минимальные
' срока и столбец выделенного блока
'--------начало блока-------------
With Range(Cells(RSMin, 1), Cells(RSMax, 256))
.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
.FormatConditions(1).Interior.ColorIndex = 35
End With
'--------конец блока---------------
' выделяются сроки выделенного диапазона
'--------начало блока---------------
With Range(Cells(1, CSMin), Cells(1, CSMax))
'With Range(Cells(1, CSMin), Cells(65000, CSMax))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
.FormatConditions(1).Interior.ColorIndex = 35
End With
'--------конец блока---------------
' выделяются столбцы выделенного диапазона
'--------начало блока---------------
With Range(Cells(RSMin, CSMin), Cells(RSMax, CSMax))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
.FormatConditions(1).Interior.ColorIndex = 0
End With
'--------конец блока---------------
' выделяется выделенный диапазон
Else
End If
End Sub