Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
[ Закрыто ] Изменить цвет строки в соответствии со значением в ячейке, Excel, VBA, макрос
 
#1
08.12.2015 10:03:45
Всем привет!
Помогите, пожалуйста, с макросом для Excel, уже облазила все, что только можно
Нужно сделать так, чтобы макрос "пробегал" значения в определенном столбце и раскрашивал строки в соответствии с НЕСКОЛЬКИМИ условиями. Пока получается проверять только одно и запускать макрос приходится по нескольку раз, потому что останавливается. Код под спойлером:
Скрытый текст
Уж больно здесь красиво, жди беды..
 
 
 
#2
08.12.2015 10:10:38
А почему бы не воспользоваться условным форматированием? Можно выделить нужный столбец и задать в разделе условное форматирование нужные условия. Сколько необходимо!
 
 
 
#3
08.12.2015 10:17:17
vdovin_sg, хотелось бы макросом как-то автоматизировать процесс, нажатием одной кнопки, так сказать, а условное форматирование каждый раз добавлять.
Уж больно здесь красиво, жди беды..
 
 
 
#4
08.12.2015 10:20:49
alcnwndrlnd, Ясно, в макросах я не силен, сам только учусь.
 
 
 
#5
08.12.2015 10:22:42
vdovin_sg, вот и я тоже, пока что :) но все еще впереди
Уж больно здесь красиво, жди беды..
 
 
 
#6
08.12.2015 10:29:55
а если попробовать использовать цикл for a=1 to 500
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Start()
Fill_Color Range("A1:A500")
End Sub
 
Sub Fill_Color(Rg As Range)
Dim cel As Range
For Each cel In Rg
a = cel.Value
[B]For a = 1 To 500[/B]
If a = 1 Then
cel.EntireRow.Interior.Color = QBColor(5)
ElseIf a = 2 Then
cel.EntireRow.Interior.Color = QBColor(3)
End If
[B]Next a[/B]
Next
End Sub
 
 
 
#7
08.12.2015 10:46:37
vdovin_sg, идея хорошая, а что делать с проверкой нескольких значений? в разных else if - ах расписать только если
Уж больно здесь красиво, жди беды..
 
 
 
#8
08.12.2015 10:52:25
Код
?
1
2
3
4
5
6
7
8
Sub Fill_Color()
Dim i As Long
Range("A1:A500").EntireRow.Interior.ColorIndex = -4142
For i = 1 To 500
 If Cells(i, 1) = 1 Then Cells(i, 1).EntireRow.Interior.ColorIndex = 4
 If Cells(i, 1) = 2 Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6
Next
End Sub
 
 
 
#9
08.12.2015 10:56:17
Код
?
1
2
3
4
5
6
7
Sub Fill_Color_2()
Dim cel As Range
Cells.Interior.ColorIndex = xlNone
For Each cel In Columns(1).SpecialCells(2, 1)
If cel = 1 Or cel = 2 Then cel.EntireRow.Interior.Color = QBColor(7 - cel.Value * 2)
Next
End Sub
 
 
 
#10
08.12.2015 11:17:13
Kuzmich, k61, тааак, спасибо, сейчас поразбираюсь.. в принципе реально вставить вместо "1" и "2" текстовые значения?
Уж больно здесь красиво, жди беды..
 
 
 
#11
08.12.2015 11:19:40
Реально
 
 
 
#12
08.12.2015 11:27:25
Kuzmich, в таком случае, подскажите, пожалуйста, синтаксис. Как-то надо сослаться на текстовое значение? Ох уж этот ВБА, с++ и то легче.. голова уже кругом
Код
?
1
2
3
4
5
6
7
8
9
10
Sub Fill_Color()
Dim i As Long
Range("A1:A500").EntireRow.Interior.ColorIndex = -4142
For i = 1 To 500
 If Cells(i, 1) = "мама" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 4
 If Cells(i, 1) = "мыла" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6
 If Cells(i, 1) = "раму" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6
 
Next
End Sub
Изменено: alcnwndrlnd - 08.12.2015 11:27:44
Уж больно здесь красиво, жди беды..
 
 
 
#13
08.12.2015 11:31:10
А что не получается. Строку с "раму" видимо надо посветить другим цветом (6 заменить)
 
 
 
#14
08.12.2015 11:36:59
Kuzmich, да, проблема была именно в этом, макрос просто не выполнялся :) что ж, всем большое спасибо и огромный "+" в карму! vdovin_sg, k61, Kuzmich
Уж больно здесь красиво, жди беды..
 
 
 
#15
08.12.2015 11:47:50
Kuzmich, и, наверное, последний вопрос.. Возможно, глупый: как проверить несколько значений и раскрасить одним цветом:
Код
?
1
2
3
4
5
6
7
8
9
Sub Fill_Color()
Dim i As Long
Range("A1:A500").EntireRow.Interior.ColorIndex = -4142
For i = 1 To 500
 If Cells(i, 1) = "мама" Or "мыла" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 4
 If Cells(i, 1) = "абракадабра" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6
 If Cells(i, 1) = "раму" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 8
Next
End Sub
Изменено: alcnwndrlnd - 08.12.2015 11:48:18
Уж больно здесь красиво, жди беды..
 
 
 
#16
08.12.2015 11:51:05
Код
?
1
If Cells(i, 1) = "мама" Or Cells(i, 1) ="мыла" Then
 
 
 
#17
08.12.2015 11:51:54
Kuzmich, "а ларчик просто открывался"  :D спасибо еще раз, огромное
Уж больно здесь красиво, жди беды..
 
 
 
#18
08.12.2015 12:08:28
Kuzmich, потревожу Вас еще раз. Не получается добавить просмотр следующего интересующего меня столбца, после прохождения первого
Код
?
1
Range("A1:A500", "B1:B500").EntireRow.Interior.ColorIndex = -4142
так?
Уж больно здесь красиво, жди беды..
 
 
 
#19
08.12.2015 12:22:39
попробуйте так:
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
Sub Fill_Color()
Dim rng As Range
Dim rng2 As Range
Set rng = Range("A1:B500")
rng.EntireRow.Interior.ColorIndex = -4142
For Each rng2 In rng
 If rng2 = "мама" Or "мыла" Then rng2.EntireRow.Interior.ColorIndex = 4
 If rng2 = "абракадабра" Then rng2.EntireRow.Interior.ColorIndex = 6
 If rng2 = "раму" Then rng2.EntireRow.Interior.ColorIndex = 8
Next
Set rng = Nothing
End Sub
Изменено: Михаил Лебедев - 10.12.2015 11:57:00 (исправил диапазон (спасибо Kuzmich-у))
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#20
08.12.2015 12:27:22
Михаил Лебедев,
Уж больно здесь красиво, жди беды..
 
 
 
#21
08.12.2015 12:42:39
Код
?
1
Range("A1:B500").EntireRow.Interior.ColorIndex = -4142
 
 
 
#22
08.12.2015 12:45:53
Kuzmich, пробовала, второй столбец не красит, но и ошибку не выдает
Уж больно здесь красиво, жди беды..
 
 
 
#23
08.12.2015 12:46:23
Код
?
1
Range("A1:A500,B1:B500")
 
 
 
#24
08.12.2015 13:02:28
Файл выложите. И/или поменяйте строку в моем коде, как предложил "кузмич" (я в своем предыдущем - поменял)
Изменено: Михаил Лебедев - 08.12.2015 13:04:02
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#25
08.12.2015 13:04:42
Цитата
второй столбец не красит
Какой столбец? Когда подсвечивается вся строка.
Или не красит по условию второго столбца?
 
 
 
#26
08.12.2015 13:14:18
Cells(i,2) - это будет второй столбец
 
 
 
#27
08.12.2015 13:20:58
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
Sub Fill_Color()
    Dim rng As Range
    Dim rng2 As Range
    Set rng = Range("A1:B10")
    rng.EntireRow.Interior.ColorIndex = -4142
    For Each rng2 In rng
        If rng2.Value2 = "мама" Or rng2.Value2 = "мыла" Then Cells(rng2.Row, 1).EntireRow.Interior.ColorIndex = 4
        If rng2.Value2 = "абракадабра" Then Cells(rng2.Row, 1).EntireRow.Interior.ColorIndex = 6
        If rng2.Value2 = "раму" Then Cells(rng2.Row, 1).EntireRow.Interior.ColorIndex = 8
    Next
    Set rng = Nothing
End Sub
Изменено: Михаил Лебедев - 08.12.2015 13:21:20
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#28
08.12.2015 13:35:51
alcnwndrlnd и vdovin_sg, код следует оформлять тегом - ищите такую кнопку (см. скрин).
alcnwndrlnd,  поменяйте, пожалуйста, в своём профиле отображаемое имя - сейчас оно с нарушением Правил. Спасибо!
 
 
 
#29
08.12.2015 13:46:53
Цитата
Kuzmich написал:
Какой столбец? Когда подсвечивается вся строка.
Или не красит по условию второго столбца?
Да, по условию. Сейчас попробую с исправлениями
Уж больно здесь красиво, жди беды..
 
 
 
#30
08.12.2015 14:39:05
Михаил Лебедев, спасибо! Kuzmich, и снова, еще раз спасибо! во всем разобралась, все работает, как надо
Код
?
1
2
3
4
5
6
7
8
9
10
11
Sub Fill_Color()
Dim i As Long
Range("A1:A500, B1:B500").EntireRow.Interior.ColorIndex = -4142
For i = 1 To 5000
 If Cells(i, 1) = "а" Or Cells(i, 1) = б" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 4
 If Cells(i, 2) = "в" Or Cells(i, 2) = "г" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 5
 If Cells(i, 1) = "д" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6
 If Cells(i, 1) = "е" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 8
  
Next
End Sub
Изменено: alcnwndrlnd - 08.12.2015 14:39:41
Уж больно здесь красиво, жди беды..
 
 
 
Страницы: 1 2 След.
Читают тему
Loading...