Добрый день! Имеется некий массив состоящий из произвольных цифр. Нужно командой выделить строку где имеется значение "100", а если значение "100" изменено на другое значение, то выделение строки нужно убрать при повторном запуске команды.
Добрый день! Имеется некий массив состоящий из произвольных цифр. Нужно командой выделить строку где имеется значение "100", а если значение "100" изменено на другое значение, то выделение строки нужно убрать при повторном запуске команды.4step
NikitaDvorets, я бы не много изменил Ваш код, а то при большом диапазоне, может здорово подтормаживать. Я бы не стал проверять весь диапазон, достаточно проверять одну строку в которой происходит изменение. Код мог бы выглядеть примерно так: [vba]
Код
Public Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, n As Integer, arr Set rng = ActiveSheet.Range("A1:E16") If Not Intersect(Target, rng) Is Nothing Then arr = ActiveSheet.Range(Cells(Target.Row, "A"), Cells(Target.Row, "E")) For n = 1 To UBound(arr, 2) If arr(1, n) = 100 Then Target.EntireRow.Interior.Color = RGB(255, 165, 0): Exit Sub Next n Target.EntireRow.Interior.Pattern = xlNone End If End Sub
[/vba] Если всё таки нужно будет проверять весь диапазон, то я бы вначале очищал весь диапазон и лишь потом, т.к. потом в любом случае закрашиваете нужные строки, примерно так: [vba]
Код
Public Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, n As Integer, m As Integer, arr Set rng = ActiveSheet.Range("A1:E16") rng.EntireRow.Interior.Pattern = xlNone If Not Intersect(Target, rng) Is Nothing Then arr = rng For m = 1 To UBound(arr) For n = 1 To UBound(arr, 2) If arr(m, n) = 100 Then Rows(m).EntireRow.Interior.Color = RGB(255, 165, 0): Exit For Next n Next m End If End Sub
[/vba] Ну а чтобы ещё увеличить скорость обработки можно использовать Union [vba]
Код
Public Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, r As Range, n As Integer, m As Integer, arr Set rng = ActiveSheet.Range("A1:E16") rng.EntireRow.Interior.Pattern = xlNone If Not Intersect(Target, rng) Is Nothing Then arr = rng For m = 1 To UBound(arr) For n = 1 To UBound(arr, 2) If arr(m, n) = 100 Then If r Is Nothing Then Set r = Rows(m) Else Set r = Union(r, Rows(m)) Exit For End If Next n Next m If Not r Is Nothing Then r.EntireRow.Interior.Color = RGB(255, 165, 0) End If End Sub
[/vba]
NikitaDvorets, я бы не много изменил Ваш код, а то при большом диапазоне, может здорово подтормаживать. Я бы не стал проверять весь диапазон, достаточно проверять одну строку в которой происходит изменение. Код мог бы выглядеть примерно так: [vba]
Код
Public Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, n As Integer, arr Set rng = ActiveSheet.Range("A1:E16") If Not Intersect(Target, rng) Is Nothing Then arr = ActiveSheet.Range(Cells(Target.Row, "A"), Cells(Target.Row, "E")) For n = 1 To UBound(arr, 2) If arr(1, n) = 100 Then Target.EntireRow.Interior.Color = RGB(255, 165, 0): Exit Sub Next n Target.EntireRow.Interior.Pattern = xlNone End If End Sub
[/vba] Если всё таки нужно будет проверять весь диапазон, то я бы вначале очищал весь диапазон и лишь потом, т.к. потом в любом случае закрашиваете нужные строки, примерно так: [vba]
Код
Public Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, n As Integer, m As Integer, arr Set rng = ActiveSheet.Range("A1:E16") rng.EntireRow.Interior.Pattern = xlNone If Not Intersect(Target, rng) Is Nothing Then arr = rng For m = 1 To UBound(arr) For n = 1 To UBound(arr, 2) If arr(m, n) = 100 Then Rows(m).EntireRow.Interior.Color = RGB(255, 165, 0): Exit For Next n Next m End If End Sub
[/vba] Ну а чтобы ещё увеличить скорость обработки можно использовать Union [vba]
Код
Public Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, r As Range, n As Integer, m As Integer, arr Set rng = ActiveSheet.Range("A1:E16") rng.EntireRow.Interior.Pattern = xlNone If Not Intersect(Target, rng) Is Nothing Then arr = rng For m = 1 To UBound(arr) For n = 1 To UBound(arr, 2) If arr(m, n) = 100 Then If r Is Nothing Then Set r = Rows(m) Else Set r = Union(r, Rows(m)) Exit For End If Next n Next m If Not r Is Nothing Then r.EntireRow.Interior.Color = RGB(255, 165, 0) End If End Sub