Суммирование чисел которые находятся в цветной ячейки

Автор Yarik, 1 февраля 2018, 11:04

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

Yarik

Столкнулся с проблемой при учете рабочего времени. Мне нужно, чтобы считало сумму чисел находящихся в определенных закрашенных ячейках с определенной области. Например как на фото, меня область J70: L81 и чтобы из этой области считало сумму только закрашенных ячеек, даже когда я закрасьте другие ячейки.
Заранее благодарю.

bigor

#1
Макрос считает сумму ячеек имеющих любую раскраску в выделенной области

Sub summcolor
Dim oSheet As Variant, i As Long
Dim oSelection As Variant, oActiveCell As Variant, oRow As Variant

oSelection = ThisComponent.getCurrentSelection()
oSpreadsheet = oSelection.getSpreadsheet()
sum=0
For i =oSelection.RangeAddress.StartRow To oSelection.RangeAddress.EndRow
    For j =oSelection.RangeAddress.StartColumn To oSelection.RangeAddress.EndColumn
If oSpreadsheet.getCellByPosition(j, i).CellBackColor <> -1 then ' сравниваем цвет
sum = sum + oSpreadsheet.getCellByPosition(j, i).getvalue
end if
   Next j
Next i
msgbox sum
End Sub
Поддержать разработчиков LibreOffice можно можно тут, а наш форум вот тут

economist

Calc в отличие от Excel - штатно умеет суммировать числа по цвету шрифта. 
Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...

Yarik

Цитата: economist от  1 февраля 2018, 12:35
Calc в отличие от Excel - штатно умеет суммировать числа по цвету шрифта. 
А как это сделать?

Yarik

Цитата: Bigor от  1 февраля 2018, 11:59
Макрос считает сумму ячеек имеющих любую раскраску в выделенной области

Sub summcolor
Dim oSheet As Variant, i As Long
Dim oSelection As Variant, oActiveCell As Variant, oRow As Variant


oSelection = ThisComponent.getCurrentSelection()
oSpreadsheet = oSelection.getSpreadsheet()
sum=0
For i =oSelection.RangeAddress.StartRow To oSelection.RangeAddress.EndRow
    For j =oSelection.RangeAddress.StartColumn To oSelection.RangeAddress.EndColumn
If oSpreadsheet.getCellByPosition(j, i).CellBackColor <> -1 then ' сравниваем цвет
sum = sum + oSpreadsheet.getCellByPosition(j, i).getvalue
end if
   Next j
Next i
msgbox sum
End Sub



Большое спасибо, но это не полностью то, что мне нужно) Мне нужно, чтобы сумма писалась в ячейке, соответственно если цвет ячейки меняю то сумма автоматически перераховуввалася и в выделенной области есть несколько ячеек разных цветов, чтобы для каждого цвета была своя ячейка с суммою 

kompilainenn

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

JohnSUN

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

Yarik

Цитата: kompilainenn от  3 февраля 2018, 13:11
мне одному кажется, что таблица принципиально не правильно сделана?
Почему???

Yarik

Цитата: JohnSUN от  3 февраля 2018, 13:46
Нет, тебе не кажется
Я понимаю, что так просто и не скажешь что не так с таблицей, но все таки в чем ошибки. Спасибо

kompilainenn

Цитата: Yarik от  3 февраля 2018, 11:52но все таки в чем ошибки
в самом принципе задания исходных данных и последующих проблем с их обработкой на этом же листе, да еще с привязкой к цвету ячейки или шрифта.

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

bigor

Цитата: Yarik от  3 февраля 2018, 11:07Мне нужно, чтобы сумма писалась в ячейке, соответственно если цвет ячейки меняю то сумма автоматически перераховуввалася и в выделенной области есть несколько ячеек разных цветов, чтобы для каждого цвета была своя ячейка с суммою

вот под ваши хотелки

Sub summcolor
Dim oSheet As Variant, i As Long
Dim oSelection As Variant, oActiveCell As Variant, oRow As Variant
oSelection = ThisComponent.getCurrentSelection()
oSpreadsheet = oSelection.getSpreadsheet()
sum_byr=0
sum_kr=0
For i =oSelection.RangeAddress.StartRow To oSelection.RangeAddress.EndRow
   For j =oSelection.RangeAddress.StartColumn To oSelection.RangeAddress.EndColumn
Select case oSpreadsheet.getCellByPosition(j, i).CellBackColor
Case 3407769  ' если бирюзовый
sum_byr = sum_byr + oSpreadsheet.getCellByPosition(j, i).getvalue
Case 16724787 ' если красный
sum_kr = sum_kr + oSpreadsheet.getCellByPosition(j, i).getvalue
End select
  Next j
Next i
'записываем в а9 сумму бирюзовых
oSpreadsheet.getCellByPosition(0, 10).setvalue(sum_byr)
'записываем в а10 сумму красных
oSpreadsheet.getCellByPosition(0, 11).setvalue(sum_kr)
End Sub

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

Yarik

Цитата: Bigor от  3 февраля 2018, 17:31
Цитата: Yarik от  3 февраля 2018, 11:07Мне нужно, чтобы сумма писалась в ячейке, соответственно если цвет ячейки меняю то сумма автоматически перераховуввалася и в выделенной области есть несколько ячеек разных цветов, чтобы для каждого цвета была своя ячейка с суммою

вот под ваши хотелки

Sub summcolor
Dim oSheet As Variant, i As Long
Dim oSelection As Variant, oActiveCell As Variant, oRow As Variant
oSelection = ThisComponent.getCurrentSelection()
oSpreadsheet = oSelection.getSpreadsheet()
sum_byr=0
sum_kr=0
For i =oSelection.RangeAddress.StartRow To oSelection.RangeAddress.EndRow
   For j =oSelection.RangeAddress.StartColumn To oSelection.RangeAddress.EndColumn
Select case oSpreadsheet.getCellByPosition(j, i).CellBackColor
Case 3407769  ' если бирюзовый
sum_byr = sum_byr + oSpreadsheet.getCellByPosition(j, i).getvalue
Case 16724787 ' если красный
sum_kr = sum_kr + oSpreadsheet.getCellByPosition(j, i).getvalue
End select
  Next j
Next i
'записываем в а9 сумму бирюзовых
oSpreadsheet.getCellByPosition(0, 10).setvalue(sum_byr)
'записываем в а10 сумму красных
oSpreadsheet.getCellByPosition(0, 11).setvalue(sum_kr)
End Sub

 
Большое спасибо, буду пробовать

Yarik

Цитата: Bigor от  3 февраля 2018, 17:31
Цитата: Yarik от  3 февраля 2018, 11:07Мне нужно, чтобы сумма писалась в ячейке, соответственно если цвет ячейки меняю то сумма автоматически перераховуввалася и в выделенной области есть несколько ячеек разных цветов, чтобы для каждого цвета была своя ячейка с суммою

вот под ваши хотелки

Sub summcolor
Dim oSheet As Variant, i As Long
Dim oSelection As Variant, oActiveCell As Variant, oRow As Variant
oSelection = ThisComponent.getCurrentSelection()
oSpreadsheet = oSelection.getSpreadsheet()
sum_byr=0
sum_kr=0
For i =oSelection.RangeAddress.StartRow To oSelection.RangeAddress.EndRow
   For j =oSelection.RangeAddress.StartColumn To oSelection.RangeAddress.EndColumn
Select case oSpreadsheet.getCellByPosition(j, i).CellBackColor
Case 3407769  ' если бирюзовый
sum_byr = sum_byr + oSpreadsheet.getCellByPosition(j, i).getvalue
Case 16724787 ' если красный
sum_kr = sum_kr + oSpreadsheet.getCellByPosition(j, i).getvalue
End select
  Next j
Next i
'записываем в а9 сумму бирюзовых
oSpreadsheet.getCellByPosition(0, 10).setvalue(sum_byr)
'записываем в а10 сумму красных
oSpreadsheet.getCellByPosition(0, 11).setvalue(sum_kr)
End Sub

 

Почти так как мне нужно))) Но я бы хотел, чтобы считало суму на весь месяц но отдельно по дням То есть выделить весь месяц включит макрос и чтоб он автоматически посчитал сумму под каждый день в согласовании с цветом ячеек) Простите, что я сразу НЕ вполне все объясняю. На фото более понятно показано, что мне нужно. Большое спасибо. Я надеюсь это реально сделать и не слишком трудно, вы сильно поможете мне

bigor

вот, выдели нужный лист и запусти
Sub summcolor
Dim oSheet As Variant, i As Long
Dim oSelection As Variant, oActiveCell As Variant, oRow As Variant
oSelection = ThisComponent.getCurrentSelection()
oSpreadsheet = oSelection.getSpreadsheet()
sum_byr=0
sum_kr=0
For j =7 To 68
For i =4 To 16
    Select case oSpreadsheet.getCellByPosition(j, i).CellBackColor
'3407769
Case  3407769 ' если бирюзовый
sum_byr = sum_byr + oSpreadsheet.getCellByPosition(j, i).getvalue
'16724787
Case 16724787 ' если красный
sum_kr = sum_kr + oSpreadsheet.getCellByPosition(j, i).getvalue
End Select
Next i
If j Mod 2 =0 Then
oSpreadsheet.getCellByPosition(j-1, 21).setvalue(sum_kr)
oSpreadsheet.getCellByPosition(j-1, 27).setvalue(sum_byr)
sum_byr=0
sum_kr=0
End if
Next j
End Sub


но я тоже склоняюсь к мысли, что чего-то изначально у тебя не додумано.
Поддержать разработчиков LibreOffice можно можно тут, а наш форум вот тут

economist

#14
А недодумано вот что: если в день две смены и два рабочих места на 3-х работников, - то чтобы посчитать выработку изделий или часы каждому - не нужно использовать цвет,а нужно прямо указывать ФИО в соседней ячейке. Или не умничать и просто взять форму Табеля учета рабочего времени. Эта форма транспонирована и не зря - пересменки, выходы в чужую смену там отлично видны, а все итоги подбиваются обычными формулами вида СУММ().

Цвет может быть, но только как вспомогательная "информация" (его можно получить автоматом - формулой =СТИЛЬ() или автоформатированием. Даже если хочется таблицу как на скрине - суммировать все равно надо по фамилиям, а не по цветам. Для этого есть готовые функции:
СЧЁТЕСЛИ, СУММЕСЛИ, СУММЕСЛИМН итд, которые позволяют реализовать любую задумку. Просто добавьте колонку ФИО.
Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...