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

Автор Aleksandr H., 21 марта 2014, 22:59

0 Пользователи и 1 гость просматривают эту тему.

Aleksandr H.

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

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


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

kompilainenn

не пробовали "Условное форматирование"? Зачем в данном случае макрос?
Поддержать разработчиков LibreOffice можно тут, а наш форум вот тут

Aleksandr H.

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

celler

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

Aleksandr H.

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

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

Hasim

Цитата: Aleksandr H. от 21 марта 2014, 23:56в условном форматирование вижу возможность истановить только 3 условия, а у меня 6
Посмотрите пока: Условное форматирование ячеек с помощью функции листа без ограничения количества условий
А потом придет JohnSUN, он всё растолкует, и про макрос тоже.

kompilainenn

Цитата: Aleksandr H. от 21 марта 2014, 23:56в условном форматирование вижу возможность истановить только 3 условия, а у меня 6
какая версия офиса? у меня неограниченное количество условий в 4.2.3.1

зы: а почему тема в разделе Basic, а не Calc?
Поддержать разработчиков LibreOffice можно тут, а наш форум вот тут

Hasim

Цитата: kompilainenn от 22 марта 2014, 14:51зы: а почему тема в разделе Basic, а не Calc?
Потому что человек хотел макрос, а макрос никто, кроме JohnSUN'a не напишет.

kompilainenn

Поддержать разработчиков LibreOffice можно тут, а наш форум вот тут

celler

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

Aleksandr H.

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

Цитата: Hasim от 22 марта 2014, 15:59
Цитата: kompilainenn от 22 марта 2014, 14:51зы: а почему тема в разделе Basic, а не Calc?
Потому что человек хотел макрос, а макрос никто, кроме JohnSUN'a не напишет.

Цитироватьно вопрос-то по Calc..
Вопрос ставился макросу в среде Basic

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

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



celler

Цитата: Aleksandr H. от 22 марта 2014, 19:53Раскраска не одноразовое действие и ето выделение и раскарску надо делать регулярно.
Так у Вас будут постоянно новые значения вноситься? Тогда если у Вас не слишком много этих разных "meshek", не лучше ли всю таблицу перевернуть. Вот я например просто транспонировал Вашу таблицу, убрал боевую раскраску и часть строк перенёс вверх. Если Вам не жалко глаз тех, кто будет с этой таблицей работать, можно конечно и раскрасить.
Цитата: Aleksandr H. от 22 марта 2014, 19:53А как сохранить стиль?
У меня LO, но в AOO думаю аналогично. Нажимаете F11, там заводите новый стиль на основе стандартного, даёте ему имя и устанавливаете в нём безцветный фон. А при УФ просто вводите условие равенства "". Сохраняете изменения.

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

Aleksandr H.

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

Aleksandr H.

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

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 скрадывает это увеличение. Однако скорость работы с книгой (особенно открытие-сохранение) быстро начнет падать, начнутся "непонятные тормоза".


[вложение удалено Администратором]
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне