powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Окрашивание ячейки
15 сообщений из 15, страница 1 из 1
Окрашивание ячейки
    #36703576
hum_i
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Добрый день!

Подскажите пожалуйста, как можно закрасить ячейку в зависимости от определенного условия?
Код: plaintext
If Cells(j,  5 ).Value = "4" Then
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36703624
Бомбизд
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
Cells(j,  5 ).Interior.ColorIndex = 4 
ColorIndex = Ф1
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36704330
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hum_i,
условное форматирование
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36704947
hum_i
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Что то не закрашивается

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
If Cells(j,  5 ).Value = "4" Then

Sql = " select"
Sql = Sql & " count(distinct(sh.subs_subs_id))"
Sql = Sql & " from serv_histories sh"
Sql = Sql & " where sh.srls_srls_id = '" + Cells(j,  2 ).Text + "'"
Sql = Sql & " and sh.srst_srst_id = 4"
Sql = Sql & " and sh.start_date >= to_date('" & dt & "', 'dd.mm.yyyy')"
Sql = Sql & " and sh.start_date < to_date('" & dt & "', 'dd.mm.yyyy')+1"
Sql = Sql & " and not exists (select s.subs_subs_id from bis.subs_histories s"
Sql = Sql & " where s.subs_subs_id = sh.subs_subs_id"
Sql = Sql & " and s.rtpl_rtpl_id in (4,38,75,79,14,35,58,39,101)"
Sql = Sql & " and sh.start_date between s.start_date and s.end_date)"

rs.Open Sql, con
Sheets("Пакеты и ТО").Select

Cells(j, i).Value = ""
Cells(j, i).CopyFromRecordset rs
Cells(j, i).Interior.ColorIndex =  4 

If Cells(j, i).Value = "" Then Cells(j, i).Value = "0"

End If
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36704949
hum_i
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Может я не в том месте поставила
Код: plaintext
Cells(j, i).Interior.ColorIndex =  4 
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36705017
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hum_i,

так у вас и закрывающего end if нет.
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36705297
hum_i
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Как же нет
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
If Cells(j,  5 ).Value = "4" Then

Sql = " select"
Sql = Sql & " count(distinct(sh.subs_subs_id))"
Sql = Sql & " from serv_histories sh"
Sql = Sql & " where sh.srls_srls_id = '" + Cells(j,  2 ).Text + "'"
Sql = Sql & " and sh.srst_srst_id = 4"
Sql = Sql & " and sh.start_date >= to_date('" & dt & "', 'dd.mm.yyyy')"
Sql = Sql & " and sh.start_date < to_date('" & dt & "', 'dd.mm.yyyy')+1"
Sql = Sql & " and not exists (select s.subs_subs_id from bis.subs_histories s"
Sql = Sql & " where s.subs_subs_id = sh.subs_subs_id"
Sql = Sql & " and s.rtpl_rtpl_id in (4,38,75,79,14,35,58,39,101)"
Sql = Sql & " and sh.start_date between s.start_date and s.end_date)"

rs.Open Sql, con
Sheets("Пакеты и ТО").Select

Cells(j, i).Value = ""
Cells(j, i).CopyFromRecordset rs
Cells(j, i).Interior.ColorIndex =  4 

If Cells(j, i).Value = "" Then Cells(j, i).Value = "0"

End If--Этот и есть закрывающий 
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36705996
Бомбизд
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
If Cells(j,  5 ).Value = "4" Then  '<--------- это первый if

Sql = " select"
Sql = Sql & " count(distinct(sh.subs_subs_id))"
Sql = Sql & " from serv_histories sh"
Sql = Sql & " where sh.srls_srls_id = '" + Cells(j,  2 ).Text + "'"
Sql = Sql & " and sh.srst_srst_id = 4"
Sql = Sql & " and sh.start_date >= to_date('" & dt & "', 'dd.mm.yyyy')"
Sql = Sql & " and sh.start_date < to_date('" & dt & "', 'dd.mm.yyyy')+1"
Sql = Sql & " and not exists (select s.subs_subs_id from bis.subs_histories s"
Sql = Sql & " where s.subs_subs_id = sh.subs_subs_id"
Sql = Sql & " and s.rtpl_rtpl_id in (4,38,75,79,14,35,58,39,101)"
Sql = Sql & " and sh.start_date between s.start_date and s.end_date)"

rs.Open Sql, con
Sheets("Пакеты и ТО").Select

Cells(j, i).Value = ""
Cells(j, i).CopyFromRecordset rs
Cells(j, i).Interior.ColorIndex =  4 


If Cells(j, i).Value = "" Then Cells(j, i).Value = "0" '<-------второй if

End If--Этот и есть закрывающий  '<-------- второй end if

End if '<----------- первый end if может быть здесь?
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36706141
hum_i
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Чтобы было нагляднее видно высылаю более подробный код. Который работает с теми End if, которые в нем есть
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
If Cells(j,  1 ).Value = "1" Then
    '-----Подключены-----
    If Cells(j,  5 ).Value = "4" Then
    
Cells(j, i).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color =  255 
        .TintAndShade =  0 
        .PatternTintAndShade =  0 
    End With

Sql = " select"
Sql = Sql & " count(distinct(sh.subs_subs_id))"
Sql = Sql & " from serv_histories sh"
Sql = Sql & " where sh.srls_srls_id = '" + Cells(j,  2 ).Text + "'"
Sql = Sql & " and sh.srst_srst_id = 4"
Sql = Sql & " and sh.start_date >= to_date('" & dt & "', 'dd.mm.yyyy')"
Sql = Sql & " and sh.start_date < to_date('" & dt & "', 'dd.mm.yyyy')+1"
Sql = Sql & " and not exists (select s.subs_subs_id from bis.subs_histories s"
Sql = Sql & " where s.subs_subs_id = sh.subs_subs_id"
Sql = Sql & " and s.rtpl_rtpl_id in (4,38,75,79,14,35,58,39,101)"
Sql = Sql & " and sh.start_date between s.start_date and s.end_date)"

rs.Open Sql, con
Sheets("Пакеты и ТО").Select

Cells(j, i).Value = ""
Cells(j, i).CopyFromRecordset rs
Cells(j, i).Interior.ColorIndex =  4 

If Cells(j, i).Value = "" Then Cells(j, i).Value = "0" '---Здесь не требуется

Cells(j, i).Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade =  0 
        .PatternTintAndShade =  0 
    End With
    
    End If
    
    '-----Отключены-----
    If Cells(j,  5 ).Value = "6" Then

Cells(j, i).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color =  255 
        .TintAndShade =  0 
        .PatternTintAndShade =  0 
    End With

Sql = " select"
Sql = Sql & " count(distinct(sh.subs_subs_id))"
Sql = Sql & " from serv_histories sh"
Sql = Sql & " where sh.srls_srls_id = '" + Cells(j,  2 ).Text + "'"
Sql = Sql & " and sh.srst_srst_id = 6"
Sql = Sql & " and sh.start_date >= to_date('" & dt & "', 'dd.mm.yyyy')"
Sql = Sql & " and sh.start_date < to_date('" & dt & "', 'dd.mm.yyyy')+1"
Sql = Sql & " and not exists (select s.subs_subs_id from bis.subs_histories s"
Sql = Sql & " where s.subs_subs_id = sh.subs_subs_id"
Sql = Sql & " and s.rtpl_rtpl_id in (4,38,75,79,14,35,58,39,101)"
Sql = Sql & " and sh.start_date between s.start_date and s.end_date)"

rs.Open Sql, con
Sheets("Пакеты и ТО").Select

Cells(j, i).Value = ""
Cells(j, i).CopyFromRecordset rs

If Cells(j, i).Value = "" Then Cells(j, i).Value = "0"

Cells(j, i).Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade =  0 
        .PatternTintAndShade =  0 
    End With
    
    End If
    
End If
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36706296
Бомбизд
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
так вот это хоть работает?
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Cells(j, i).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color =  255   'это закрашивает ячейку
      '.colorindex=6 'или так
      '.color= RGB(255,0,0) ' или так?
        .TintAndShade =  0 
        .PatternTintAndShade =  0 
    End With
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36706338
hum_i
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Это работает. Этот работает так, при запуске перед заполнением ячейка окрашивается в красный цвет и так до конца пока не заполнит все ячейки.
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36707338
Бомбизд
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Попробуй так
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Cells(j, i).Value = ""
Cells(j, i).CopyFromRecordset rs

If Cells(j, i).Value = "" Then Cells(j, i).Value = "0" '---Здесь не требуется
Cells(j, i).Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade =  0 
        .PatternTintAndShade =  0 
    End With
    Cells(j, i).Interior.ColorIndex =  4  ' <----------это поместить перед end if
    End If
или выполни пошагово
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36707524
hum_i
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Сейчас заработало спасибо. Но вот такой еще вопрос а применение RGB оттенков возможно?
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36707586
hum_i
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Сама разобралась Cells(j, i).Interior.Color = RGB(......) . Спасибо за помощь
...
Рейтинг: 0 / 0
Окрашивание ячейки
    #36707681
Бомбизд
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
[offtop]hum_iСпасибо за помощь
дзинь! 0.20 юнидоллара за использование популярной фразы :)
[/offtop]
...
Рейтинг: 0 / 0
15 сообщений из 15, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Окрашивание ячейки
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]