Профессиональные приемы работы в Microsoft Excel

Обмен опытом => Microsoft Excel => Тема начата: yuldash от 11.11.2015, 13:19

Название: Окрашивание строк в 2 цвета
Отправлено: yuldash от 11.11.2015, 13:19
Добрый день.
Задача такая. в таблице Excel в 4м столбце только 2 типа значений. 1 и 2. Надо покрасить строки со значением 1 в зеленый, а строки со значением 2 в желтый. Надо прописать в макросе.
у меня примерно получается, но окрашивает один раз и останавливается.
вот пример 
Sub Макрос1()
Dim rFoundRng As Range

    Set rFoundRng = Columns(4).Find(1)
    If Not rFoundRng Is Nothing Then
   Range(Cells(rFoundRng.Row, 1), Cells(rFoundRng.Row, 14)).Interior.ColorIndex = 6
    End If
   
Set rFoundRng = Columns(4).Find(2)
    If Not rFoundRng Is Nothing Then
   Range(Cells(rFoundRng.Row, 1), Cells(rFoundRng.Row, 14)).Interior.ColorIndex = 4
    End If
End Sub
Название: Re: Окрашивание строк в 2 цвета
Отправлено: iron priest от 11.11.2015, 13:34
и зачем это делать через макрос?
Название: Re: Окрашивание строк в 2 цвета
Отправлено: yuldash от 11.11.2015, 13:40
Слишком большая таблица
Название: Re: Окрашивание строк в 2 цвета
Отправлено: iron priest от 11.11.2015, 13:43
мульён?
Название: Re: Окрашивание строк в 2 цвета
Отправлено: yuldash от 11.11.2015, 13:48
Цитата: iron priest от 11.11.2015, 13:43
мульён?
Да.
попытался цикл организовать - не получилось
Название: Re: Окрашивание строк в 2 цвета
Отправлено: cheshiki1 от 11.11.2015, 17:33
цикл, на мульёне не скажу как себя поведет, опыта мало.
Dim i%
For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row
    Range(Cells(i, 1), Cells(i, 14)).Interior.ColorIndex = Choose(Cells(i, 4), 4, 6)
Next
Название: Re: Окрашивание строк в 2 цвета
Отправлено: vikttur от 11.11.2015, 18:07
С массивом быстрее.
Сначала формируем диапазоны для заливки, в конце одним махом заливаем все строки:
Sub RngColor()
Dim ArrData
Dim rRng1 As Range, rRng2 As Range
Dim lRws As Long
Dim i As Long
    With ActiveSheet
        lRws = .UsedRange.Rows.Count
        If lRws < 2 Then Exit Sub
        ArrData = Range("D1:D" & lRws).Value ' значения столбца 4 в массив
       
        For i = 1 To lRws
            Select Case ArrData(i, 1) ' по значениям
                Case 1
                    If rRng1 Is Nothing Then
                        Set rRng1 = .Range(.Cells(i, 1), .Cells(i, 14)) ' формируем диапазон
                    Else
                        Set rRng1 = Union(rRng1, .Range(.Cells(i, 1), .Cells(i, 14))) 'пополняем диапазон
                    End If
                Case 2
                    If rRng2 Is Nothing Then
                        Set rRng2 = .Range(.Cells(i, 1), .Cells(i, 14))
                    Else
                        Set rRng2 = Union(rRng2, .Range(.Cells(i, 1), .Cells(i, 14)))
                    End If
            End Select
        Next i
   
        Application.ScreenUpdating = False
        .UsedRange.Interior.Pattern = xlNone ' удаление предыдущей заливки
        If Not rRng1 Is Nothing Then rRng1.Interior.ColorIndex = 6 ' красим диапазоны
        If Not rRng2 Is Nothing Then rRng2.Interior.ColorIndex = 4
        Application.ScreenUpdating = True
    End With
End Sub

В таком варианте обращения к листу минимальны -  только для получения данных в массив и для массовой заливки двух диапазонов.
Название: Re: Окрашивание строк в 2 цвета
Отправлено: yuldash от 12.11.2015, 07:15
Спасибо, Попробую.
А как сделать, чтобы он автоматически все сделал?
например, я вбил новую строку, а он автоматически запускается
Название: Re: Окрашивание строк в 2 цвета
Отправлено: cheshiki1 от 12.11.2015, 08:27
посмотрите про событие Worksheet_Change