Добрый день, друзья! Как всегда нужна Ваша помощь) Возможно ли на вкладке Продажи просуммировать числа слева направо по строке, с условием начальная точка ячейка с зеленой заливкой, а последняя точка белая ячейка перед следующей зеленой, пример на картинке, файл во вложении
DANIKOLA результат должен быть в точке отсчета, то есть в зеленой ячейке
БМВ цикл суммирования отсчитывается с зеленой ячейки, соответственно если несколько зеленых ячеек то несколько результатов, наглядно в приложенной картинке
написал: результат должен быть в точке отсчета, то есть в зеленой ячейке
Как узнать что именно вот такая-то ячейка и есть "точка отсчета"? На скринах много зеленых, в скачанном файле у меня вообще нет ни одного условия УФ (возможно из-за версии, у меня 2007)...
MorsSvejiy, кмк игра не стоит свеч - всё равно придётся выделять диапазон для анализа (это сейчас всё с 1.11 по 1.12, потом то изменится?). Всё равно вы выделяете зелёным ячейку. Проще сразу в ячейку прописать СУММ и выделить диапазон суммирования до следующей зелёной. Или Вы хотите оставить только цифру в закрашенной, а до след.закрашенной удалять? И да, зачем используете =ПРОМЕЖУТОЧНЫЕ.ИТОГИ(9;AF4:AF1048576) вместо СУММ(AF4:AF1048576) ? Просто интересно...
ттааак, вроде задача становится более понятно, но вот становится ли она более реализуемо?
Есть таблица заполненная константами. По связке ID и даты проверяется статус и если выполнен, то ячейка подкрашивается. Теперь хочется чтоб в ней суммировались значения самой себя и тех ячеек которые правее до следующей подкрашенной. И вот тут м получаем или макрос для разовой обработки, после которой константы в закрашенных ячейка поменяются, или нужно думать о другом представлении данных и результата.
Function getRGB1(FCell As Range) As String
Dim xColor As String
xColor = CStr(FCell.Interior.Color)
xColor = Right("000000" & Hex(xColor), 6)
getRGB1 = Right(xColor, 2) & Mid(xColor, 3, 2) & Left(xColor, 2)
End Function
Sub Zamena()
Dim i As Integer, j As Integer, k As Integer, rez As Single
Dim i0 As Integer, j0 As Integer, imax As Integer, jmax As Integer
i0 = 2 ' минимальный номер строки с которой производить обработку
imax = 10 ' максимальный номер строки с которой производить обработку
j0 = 1 ' минимальный номер столбца с которым производить обработку
jmax = 10 ' максимальный номер столбца с которым производить обработку
For i = i0 To imax ' Перебор по строкам
For j = j0 To jmax ' Перебор по столбцам
If getRGB1(Cells(i, j)) <> "FFFFFF" Then
rez = Cells(i, j).Value
For k = j + 1 To jmax ' Перебор по столбцам начиная с следующей ячейки
If getRGB1(Cells(i, k)) <> "FFFFFF" Then
Exit For
Else
rez = rez + Cells(i, k).Value
Cells(i, k).Value = ""
End If
Next k
Cells(i, j).Value = rez
Else
Cells(i, j).Value = "" ' Удаляю числа в незакрашенной ячейке до первой закрашенной
End If
Next j
Next i
End Sub
Если ребята поправят/оптимизируют - ноу проблем. Или сами.
Sub CalcSum()
Dim rg As Range, rw As Range, c As Range, c1 As Range
Set rg = Range(Cells(Rows.Count, 2).End(xlUp).Offset(0, 2), Cells(3, Columns.Count).End(xlToLeft).Offset(1))
For Each rw In rg.Rows
For Each c In rw.Cells
If c.DisplayFormat.Interior.Color = 11854022 Then
Set c1 = c
Else
If Not c1 Is Nothing Then c1 = c1 + c
c = Empty
End If
Next: Set c1 = Nothing
Next
End Sub
на основании второго листа можно было составить словарь данные взять в массив и проверять уже не цвет ячейки, а комбинацию, составляющую ключ на наличие в словаре было бы раз в 100 быстрее, но раза в 2 больше кода писать мне писать код, а не ждать пока For Each будет ячейки перебирать, поэтому написал вариант оптимальный по размеру кода (количеству набранных моими руками букв и символов) а не по быстродействию кода)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Ігор Гончаренко, Однако если: сменить цвет заливки (вот захотелось) или добавить строку выше таблицы (понадобилось сместить всё на одну строку вниз) ваш приём работать не будет...
Естественно работает. Я привязывался, если внимательно посмотреть, к отсутствию заливки отличной от дефолтной... (или к наличию заливки отличной от дефолтной...(0_о) ) Т.е. наличие любой заливки воспринимается одинаково.
tutochkin, поздно! Не Игорю нужно было говорить, а ТС-у:
Цитата
tutochkin написал: если: сменить цвет заливки (вот захотелось) или добавить строку выше таблицы (понадобилось сместить всё на одну строку вниз) ваш приём работать не будет...
т.к.
Цитата
MorsSvejiy написал: Проблема решена, тема закрыта))
_Igor_61 написал: поздно! Не Игорю нужно было говорить, а ТС-у:
На самом деле я тут исключительно ради собственного интереса (как наверное и все). И мне действительно понравилось решение Гончаренко (мне было просто лень прописывать границы и я возложил сие на ТС), но хотелось бы иметь рабочий вариант.
это не мой прием, а мое решение конкретной задачи) а захочется автору сменить цвет заливки, или добавить сверху пару очень важных строк, он напишет новый вопрос или найдет, что нужно исправить в предложенном мною решении в реализации любой задачи можно наворотить проверок, запросов к пользователю, диалоговых окон.... на 150-200 и более строк кода, но во-первых, он за всем этим и не поймет а где, собственно, те 10 строк, которые решают задачу (и будет такой ответ полезен или вреден - отдельный вопрос) во-вторых, мои принципы не позволяют писать бесплатно 100 строк кода (решение за 5-15 минут, на 10-20 строк кода - это развлечение, а 100 строк кода и больше часа-двух на реализацию - это работа, работать работу бесплатно - глубоко аморально. в этом правиле есть одно исключение - это интересная задача! если задача интересна - вообще не важно сколько времени уйдет на решение, два часа или два дня, или две недели - интересную задачу просто интересно решить)
и еще... если кто-то думает что я отвечаю тут на вопросы из-за врожденного гуманизма или приобретенного всепоглощающего человеколюбия, то это ошибка))... я так развлекаюсь
БМВ написал: то есть заливка сделанное условным форматирование у вас считывается просто так без DisplayFormat ? Я собственно об этом.
Поправил. Теперь заливка и ручная и условным форматированием считается. Вообще по хорошему бы делал опорную ячейку, с цветом которой бы сравнивал...
Код
Function getRGB1(FCell As Range) As String
Dim xColor As String
xColor = CStr(FCell.DisplayFormat.Interior.Color) ' Тут внёс правку...
xColor = Right("000000" & Hex(xColor), 6)
getRGB1 = Right(xColor, 2) & Mid(xColor, 3, 2) & Left(xColor, 2)
End Function
Sub Zamena()
Dim i As Integer, j As Integer, k As Integer, rez As Single
Dim i0 As Integer, j0 As Integer, imax As Integer, jmax As Integer
i0 = 4 ' минимальный номер строки с которой производить обработку
imax = 14 ' максимальный номер строки с которой производить обработку
j0 = 4 ' минимальный номер столбца с которым производить обработку
jmax = 68 ' максимальный номер столбца с которым производить обработку
For i = i0 To imax ' Перебор по строкам
For j = j0 To jmax ' Перебор по столбцам
If getRGB1(Cells(i, j)) <> "FFFFFF" Then ' Проверяю на отличие от дефолтной заливки
rez = Cells(i, j).Value
For k = j + 1 To jmax ' Перебор по столбцам начиная с следующей ячейки
If getRGB1(Cells(i, k)) <> "FFFFFF" Then ' Если наткнулся на закрашенную ячейку
Exit For
Else
rez = rez + Cells(i, k).Value
Cells(i, k).Value = ""
End If
Next k
Cells(i, j).Value = rez
Else
Cells(i, j).Value = "" ' Удаляю числа в незакрашенной ячейке до первой закрашенной
End If
Next j
Next i
End Sub
Ігор Гончаренко написал: во-вторых, мои принципы не позволяют писать бесплатно 100 строк кода(решение за 5-15 минут, на 10-20 строк кода - это развлечение, а 100 строк кода и больше часа-двух на реализацию - это работа, работать работу бесплатно - глубоко аморально. в этом правиле есть одно исключение - это интересная задача! если задача интересна - вообще не важно сколько времени уйдет на решение, два часа или два дня, или две недели - интересную задачу просто интересно решить)
Зеленую ТС захотел... А если желтую? Куча тем уже была на эту тему... Интересно для решений, но чревато для ТС-ов.... В подобных темах ТС-ам желательно объяснять как можно чаще и сильнее (тапки и пр.) что сперва - значения, а потом - краски (ИМХО)
_Igor_61 написал: сперва - значения, а потом - краски
Потеря приоритетов частенько проявляется. Например, человек, делая первые шаги и создав свою первую UserForm тут же спрашивает: а как сделать в заголовке бегущую строку? Как на форме разместить анимированную картинку? )
_Igor_61 написал: В подобных темах ТС-ам желательно объяснять как можно чаще и сильнее
в целом мысль настолько же правильная насколько и утопическая какой смысл обьяснять это ТС-у, который уже спроектировал файл и сформулировал проблему, в которую он уткнулся в рамках своего проекта? сюда придут тысячи других ТС-ов, и далеко не факт, что даже те, кто воспользовался поиском, увидят, прочитают, поймут и воспользуются этими рекомендациями а тем, кто даже не начинал с поиска - все написанное нами здесь за многие годы вообще по барабану поэтому - стремимся к идеалу, но работаем в реалиях
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
tutochkin, 1. не понимаю, зачем для сравнения преобразовывать в текст RGB. Есть десятичное значение и его надо сразу сравнивать. 2. Конечно все зависит от задачи, но если заливка будет отличной от &FFFFFF на единицу, да даже и больше, то глазом не отличить , а воспримется неравенством. По этому я за вариант с четки определением цвета. 3. ну если сделали третий цикл и дошли до закрашенной, то наверно можно второй цикл продолжить с этого места, а не перебирать все заново? 4. что-то мге подсказывает, что хвост после последней закрашенной будет стерт, а сумма будет все равно прописана в последнюю закрашенную хотя по условию вроде только то что между . Нужно ли это?
Ну а так да
Цитата
MorsSvejiy написал: данный макрос решит множество проблем
БМВ написал: 1. не понимаю, зачем для сравнения преобразовывать в текст RGB. Есть десятичное значение и его надо сразу сравнивать.
Привычка.
Цитата
БМВ написал: 2. Конечно все зависит от задачи, но если заливка будет отличной от &FFFFFF на единицу, да даже и больше, то глазом не отличить , а воспримется неравенством. По этому я за вариант с четки определением цвета.
Согласен. и писал про опорную заливку. Изначально так и было сделано (была не проверка <> FFF, а равенство контрольному цвету)
Цитата
БМВ написал: 3. ну если сделали третий цикл и дошли до закрашенной, то наверно можно второй цикл продолжить с этого места, а не перебирать все заново?
Можно.
Цитата
БМВ написал: 4. что-то мге подсказывает, что хвост после последней закрашенной будет стерт, а сумма будет все равно прописана в последнюю закрашенную хотя по условию вроде только то что между . Нужно ли это?
И тут Вы правы.
В любом случае я хотел не просто дать конечное решение, а показать все этапы, чтобы пользователь сам мог понять и поправить/расширить. Для этого и много комментов.
БМВ, я не программист ни разу - у меня другая специализация, посему к критике по программированию отношусь спокойно. Может подскажете в одном вопросе. Хотел ускорить работу обработки, и по заветам Уокенбаха перенести диапазон в массив, непосредственно с массивом работать и затем залить его обратно на лист. С переносом значений проблем нет, а вот значения заливки не получается... Подскажите?
Код
Sub Zamena2()
Dim i As Integer, j As Integer, k As Integer, rez As Single
Dim x As Variant, xCol As Variant
x = Range("data").Value ' Забираем значения
xCol = Range("data").DisplayFormat.Interior.Color ' Не хочет принимать
For i = 1 To UBound(x, 1) ' Перебор по строкам
For j = 1 To UBound(x, 2) ' Перебор по столбцам
' Ну тут собственно работа с массивом, сравнения и т.д.
Next j
Next i
Range("data") = x ' Заливаем значения
End Sub
tutochkin написал: xCol = Range("data").DisplayFormat.Interior.Color ' Не хочет принимать
естественно не примет, коллекцию , а точнее одно из свойств в массив просто так не передать.
В данном случае оптимизировать нужно изначальный подход и это мы обсудили в двух словах с Игорем. А работа со свойствами ячейки (за исключением её значения) - это всегда перебор ячеек.