Добрый день! Имеется некий массив состоящий из произвольных цифр. Нужно командой выделить строку где имеется значение "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
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
