Изменить цвет фона ячейки в зависимости от значения другой ячейки[РЕШЕНО]

[Aleksandr H.]

Здравствуйте.
Прошу помощи с макросом. Задание: изменить цвет фона ячеек в столбцах A-Q,U в зависимости от значения ячейки столбца U.
В столбце U в каждой ячейке может быть одно из значений 20, 28, 40, 42, 48, 60. Надо изменить цвет фона ячеек A-Q,U в етой строке если ячейка непустая.
Количество строк может изменяться +-.

В файле лист "начало" - входные данные. Лист "Результат" - ожидаемый результат работы макроса (новый лист создавать ненужно)


[вложение удалено Администратором]

[kompilainenn]

не пробовали "Условное форматирование"? Зачем в данном случае макрос?

[Aleksandr H.]

1. в условном форматирование вижу возможность истановить только 3 условия, а у меня 6
2. макрос должен уменьшить время потраченое на написание условий УФ или вручную раскрашивания ячеек

[celler]

А не проще закрасить вручную одним цветов всю площадь, а не только ячейки со значением. В крайнем случае можно все пустые ячейки потом сделать безцветными с помощью условного форматирования.

[Aleksandr H.]

А не проще закрасить вручную одним цветов всю площадь, а не только ячейки со значением.
В крайнем случае можно все пустые ячейки потом сделать безцветными с помощью условного форматирования.

Почему Вы считаете что вручную закрашивать ячейки, вписывать условия УФ ето проще чем нажать кнопку запуска макроса?

[Hasim]

в условном форматирование вижу возможность истановить только 3 условия, а у меня 6

Посмотрите пока: Условное форматирование ячеек с помощью функции листа без ограничения количества условий
А потом придет JohnSUN, он всё растолкует, и про макрос тоже.

[kompilainenn]

в условном форматирование вижу возможность истановить только 3 условия, а у меня 6

какая версия офиса? у меня неограниченное количество условий в 4.2.3.1

зы: а почему тема в разделе Basic, а не Calc?

[Hasim]

зы: а почему тема в разделе Basic, а не Calc?

Потому что человек хотел макрос, а макрос никто, кроме JohnSUN'a не напишет.

[kompilainenn]

но вопрос-то по Calc...

[celler]

Почему Вы считаете что вручную закрашивать ячейки, вписывать условия УФ ето проще чем нажать кнопку запуска макроса?

Потому что выделить и раскрасить шесть отсортированных полей займёт пару минут и однозначно будет быстрее, чем писать макрос. На этом я предлагаю и остановиться. А если уж действительно нужно, чтобы пустые ячейки были незакрашенными, тогда можно и УФ использовать и всего лишь с одним простейшим условием. Всего лишь заведите стиль без заливки, выделите всю зону C2:Q39 и с помощью УФ для всех пустых ячеек установите этот стиль.

[Aleksandr H.]

Офис: AOO410m14(Build:9760)  -  Rev. 1573601
2014-03-03 17:47:48 (Mo, 03 Mrz 2014)

зы: а почему тема в разделе Basic, а не Calc?

Потому что человек хотел макрос, а макрос никто, кроме JohnSUN'a не напишет.

но вопрос-то по Calc..

Вопрос ставился макросу в среде Basic

Потому что выделить и раскрасить шесть отсортированных полей займёт пару минут и однозначно будет быстрее, чем писать макрос.

Раскраска не одноразовое действие и ето выделение и раскарску надо делать регулярно.

Всего лишь заведите стиль без заливки, выделите всю зону C2:Q39 и с помощью УФ для всех пустых ячеек установите этот стиль.

А как сохранить стиль?

[celler]

Раскраска не одноразовое действие и ето выделение и раскарску надо делать регулярно.

Так у Вас будут постоянно новые значения вноситься? Тогда если у Вас не слишком много этих разных "meshek", не лучше ли всю таблицу перевернуть. Вот я например просто транспонировал Вашу таблицу, убрал боевую раскраску и часть строк перенёс вверх. Если Вам не жалко глаз тех, кто будет с этой таблицей работать, можно конечно и раскрасить.

А как сохранить стиль?

У меня LO, но в AOO думаю аналогично. Нажимаете F11, там заводите новый стиль на основе стандартного, даёте ему имя и устанавливаете в нём безцветный фон. А при УФ просто вводите условие равенства "". Сохраняете изменения.

[вложение удалено Администратором]

[Aleksandr H.]

Ув. celler, Вы можете помочь с написанием макроса, который б сделал то о чем я просил в 1-ом сообщении? Я, конечно, благодарен за Ваше участвие, но если не можете, то попрошу не флудить

[Aleksandr H.]

Вот такой код родился за 3 дня. Первый в среде OOoBasic 
Прошу замечания.

Код:

sub Colored() 'процедура раскраски
dim oShDoc as object ' Объявление объектной переменной всего табличного документа
dim oSheet as object ' Объявление объектной переменной листа табличного документа
dim oCell as object ' Объявление объектной переменной ячейки листа табличного документа
dim oCell2 as object ' Объявление объектной переменной ячейки листа табличного документа
dim RCount as integer
oShDoc=thiscomponent
oSheet=oShDoc.CurrentController.ActiveSheet ' получения активного листа

'oFunction=createUnoService("com.sun.star.sheet.FunctionAccess")
'RCount =  oFunction.callFunction("COUNTA", array("A1:A500"))  ' не могу найти синтаксиса как в переменную передать результат матфункции

oSheet.getcellbyposition(25,0).formula = "=COUNTA(A1:A500)" ' количесто заполненных строк
RCount = oSheet.getcellbyposition(25,0).value - 1

for i= 1 to RCount ' цикл по строках
if oSheet.getcellbyposition(20, i).value <> oSheet.getcellbyposition(20,i-1).value then
ColorCell(i) ' если U предыдущей строки не равно U текущей строки - изменить цвет заливки
else oSheet.getcellbyposition(20, i).CellBackColor = oSheet.getcellbyposition(20, i-1).CellBackColor  ' установить заливку как в U(20, i-1)
end if
for j = 0 to 16 ' цикл по столбцах
If ((oSheet.getcellbyposition(j,i).Type <> com.sun.star.table.CellContentType.EMPTY )) then ' если ячейка не пустая
oSheet.getcellbyposition(j,i).CellBackColor = oSheet.getcellbyposition(20,i).CellBackColor
end if
next
next
end sub

sub ColorCell(Pos as Integer) ' выбор цвета ячейки
dim oShDoc as object ' Объявление объектной переменной всего табличного документа
dim oSheet as object ' Объявление объектной переменной листа табличного документа
oShDoc=thiscomponent
oSheet=oShDoc.CurrentController.ActiveSheet ' получения активного листа
select case  oSheet.getcellbyposition(20, Pos).value
Case 28: oSheet.getcellbyposition(20, Pos).CellBackColor = RGB (34, 139, 34)
        Case 20: oSheet.getcellbyposition(20, Pos).CellBackColor = RGB (255, 255, 0)
        Case 32: oSheet.getcellbyposition(20, Pos).CellBackColor = RGB (0, 191, 255)
        Case 40: oSheet.getcellbyposition(20, Pos).CellBackColor = RGB (0, 238, 0)
        Case 48: oSheet.getcellbyposition(20, Pos).CellBackColor = RGB (218, 165, 32)
        Case 60: oSheet.getcellbyposition(20, Pos).CellBackColor = RGB (139, 134, 130)
end select
end sub

[JohnSUN]

Макрос хороший получился, результат тот, что и запрашивался.
Однако я все-таки рекомендовал бы прислушаться к советам насчет условного форматирования.
Дело в том, что такая "индивидуальная раскраска ячеек" очень сильно нагружает документ излишним контентом.
Попробуйте заглянуть в файл с помощью архиватора до и после выполнения макроса, оцените изменение размера файла content.xml. На самом ods-файле это не очень заметно, zip скрадывает это увеличение. Однако скорость работы с книгой (особенно открытие-сохранение) быстро начнет падать, начнутся "непонятные тормоза".


[вложение удалено Администратором]