подскажите пожалуйста как сделать так чтобы при нажатие на ячейку с названием к примеру Barcelona (как в моём примере) выделились все ячейки с данным названием, что бы легче было ориентироваться в списке.
подскажите пожалуйста как сделать так чтобы при нажатие на ячейку с названием к примеру Barcelona (как в моём примере) выделились все ячейки с данным названием, что бы легче было ориентироваться в списке.TanyaZorina
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If IsEmpty(Target) Then Exit Sub Dim Rng As Range: Set Rng = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row) If Intersect(Rng, Target) Is Nothing Then Exit Sub Application.ScreenUpdating = False Dim i As Long, addr As String, arr: arr = Rng.Value Rng.Interior.Color = vbWhite For i = 1 To UBound(arr) If arr(i, 1) = Target Then If addr = "" Then addr = "D" & i Else addr = addr & ", D" & i Next Range(addr).Interior.Color = vbRed Application.ScreenUpdating = True End Sub
[/vba]
Или макросом на событие выделения ячейки [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If IsEmpty(Target) Then Exit Sub Dim Rng As Range: Set Rng = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row) If Intersect(Rng, Target) Is Nothing Then Exit Sub Application.ScreenUpdating = False Dim i As Long, addr As String, arr: arr = Rng.Value Rng.Interior.Color = vbWhite For i = 1 To UBound(arr) If arr(i, 1) = Target Then If addr = "" Then addr = "D" & i Else addr = addr & ", D" & i Next Range(addr).Interior.Color = vbRed Application.ScreenUpdating = True End Sub