2015-07-17 12 views
0

я получил следующий макрос в моей книге:Macro только для определенного диапазона ячеек

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
' Clear the color of all the cells 
Cells.Interior.ColorIndex = 0 
If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub 
Application.ScreenUpdating = False 
With ActiveCell 
    ' Highlight the row and column that contain the active cell, within the current region 
    Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Interior.ColorIndex = 8 
    Range(Cells(.CurrentRegion.Row, .Column), Cells(.CurrentRegion.Rows.Count + .CurrentRegion.Row - 1, .Column)).Interior.ColorIndex = 8 
End With 
Application.ScreenUpdating = True 
End Sub 

Но я хотел бы, чтобы это работать только на клетках F8:IR254, которая является матрицей области.

В настоящее время он работает в каждой ячейке, которая содержит название региона, также вне матрицы.

Возможно ли это?

Заранее спасибо.

С наилучшими пожеланиями, S

ответ

1

Да, это возможно.

Вы должны добавить эти строки кода в начале вашего Суб:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    Dim rng As Range: Set rng = Range("F8:IR254") 
    If intersect(Target, rng) Is Nothing Then Exit Sub 
+0

Большое спасибо, это было именно это я искал. –

0

Вы должны использовать функцию Application.Intersect() знать, если два (или более) диапазоны имеют общую часть или нет.

Вы можете найти исправленную код:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub 

If Not Application.Intersect(Target, Me.Range("F8:IR254")) Is Nothing Then 
    'Clear the color of all the cells 
    Cells.Interior.ColorIndex = 0 
    Application.ScreenUpdating = False 
    With ActiveCell 
     ' Highlight the row and column that contain the active cell, within the current region 
     Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Interior.ColorIndex = 8 
     Range(Cells(.CurrentRegion.Row, .Column), Cells(.CurrentRegion.Rows.Count + .CurrentRegion.Row - 1, .Column)).Interior.ColorIndex = 8 
    End With 
    Application.ScreenUpdating = True 
Else 
    'Outside of matrix 
End If 

End Sub 
+0

Спасибо, это тоже работало так же, как ответ Mielks. Для меня, как новичка с VBA, ответ Mielks легче следовать. Спасибо, в любом случае! –

Смежные вопросы