Подсветка выделенных ячеек-ограничить диапазон

[Uralmaster]

1.Выделенная ячейка подсвечивается в центре и по вертикали и горизонтали
Как в этом коде ограничить диапазон подсветки (центра - вертикали-горизонтали) + дипазон работы?В моем случае ограничить диапазоном B11:J5000
2.При выделении нескольких ячеек выскакивает ошибка-как ее убрать ?


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.Color Index = 40
End With
'--------конец блока---------------
' выделяются сроки выделенного диапазона
'--------начало блока---------------
With Range(Cells(1, CSMin), Cells(65000, CSMax))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
.FormatConditions(1).Interior.Color Index = 36
End With
'--------конец блока---------------
' выделяются столбцы выделенного диапазона
'--------начало блока---------------
With Range(Cells(RSMin, CSMin), Cells(RSMax, CSMax))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
.FormatConditions(1).Interior.Color Index = 34
End With
'--------конец блока---------------
' выделяется выделенный диапазон
Else
End If
End Sub

[EducatedFool]

1. Если у вас в процедуру передается переменная Target

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

то нехорошо использовать её в таком виде:

For Each Target In Selection.Cells

2. Зачем так всё усложнять?
Использовать условное форматирование в качестве подсветки - примерно то же самое, что разводить костёр для прикуривания сигареты, ибо оно требует очень много ресурсов

Есть же другие способы координатного выделения - чем они вас не устраивают?

[SAS888]

Можно так:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim x As Range: Set x = [B11:J5000]: Cells.Interior.ColorIndex = xlNone
    If Not Intersect(Target, x) Is Nothing Then
        Intersect(x, Target.EntireRow).Interior.ColorIndex = 6
        Intersect(x, Target.EntireColumn).Interior.ColorIndex = 6
    End If
End Sub

Пример во вложении.

[Uralmaster]

Спасибо Сергей за помощь - в вашем файле "Пример" все работает в диапазоне но вот только форматирование при этом вне диапазона пропадает - можно это както поправить ?

[Uralmaster]

Вот нашел хороший пример координатного выделения

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim addr As String
Dim x As Variant
Dim rng, c, r, cll As String

If NoEvents Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
addr = ActiveCell.Address()
x = Split(addr, "$")

c = x(1)
r = x(2)
rng = c & ":" & c & "," & r & ":" & r
Range(rng).Select
cll = c & r
Range(cll).Activate
End Sub

Как сделать так чтобы:
-диапазон подсветки ограничить диапазоном B11:J5000;
-дипазон работы ограничить диапазоном B11:J5000;
-цвет подсветки сделать светло-зеленым (ячейка выделенная при этом остается без заливки и с рамкой как в оригинале);
-оставить только горизонтальное выделение (вертикальное чтоб не работало)

[SAS888]

Так устроит?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim x As Range: Set x = [B11:J5000]: x.Interior.ColorIndex = xlNone
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, x) Is Nothing Then Intersect(x, Target.EntireRow).Interior.ColorIndex = 4
    Target.Interior.ColorIndex = xlNone
End Sub

Пример во вложении.

[Uralmaster]

Все работает только одно надо исправить - снимает форматирование по цвету с ячеек вне диапазона; файл во вложении

[SAS888]

снимает форматирование по цвету с ячеек вне диапазона

Чтобы этого не происходило, нужно "обесцвечивание" активной ячейки выполнять только по условию. Т.е. код будет такой:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim x As Range: Set x = [B11:J5000]: x.Interior.ColorIndex = xlNone
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, x) Is Nothing Then
        Intersect(x, Target.EntireRow).Interior.ColorIndex = 35
        Target.Interior.ColorIndex = xlNone
    End If
End Sub

P.S. Совет на будущее: не нужно "править" пост без особой необходимости. Если бы Вы создали новый пост, то наверняка это все увидят. А если Вы исправили уже существующий, то большая вероятность того, что этого никто не заметит. Я по чистой случайности зашел в эту тему, т.к. некоторое время назад Вас все устраивало. А новых постов в теме нет...