СообЧа > База Знаний > Программы > MS Excel

Вопрос

Давно мучаюсь вопросом: можно ли сделать так, чтобы суммировались только те ячейки, в которых цифры выделены другим цветом (например синим)?

Ответ

И вот, наконец, выдалось свободное времечко в достаточном количестве, чтобы накидать такой вот текстик (специально продвинутых юзеров типа «глаз-алмаз», поскольку для использования его нужно знать, каким числом обозначается интересующий вас цвет):

Public Function ColorSum(sRange As String, vColor As Variant) As Double
'Written by Alex Juice, 07.10.2001
'
'Вычисление суммы значений ячеек с определенным цветом шрифта
'
'Пример записи в ячейке:
'=PERSONAL.XLS!ColorSum.ColorSum("A1:A7";255)
'(при условии что функция хранится в личной книге макросов
'в модуле «ColorSumModule», хотя можно модуль и не указывать)
'вычислит сумму значений
'ячеек диапазона A1:A7, в которых цвет шрифта красный
'
Dim rng As Range, dblSum As Double, i As Integer
Dim r As Integer, c As Integer, r1 As Integer, c1 As Integer
'Узнаем координаты текущей ячейки (строку и столбец)
r = ActiveCell.Row
c = ActiveCell.Column
Set rng = Range(sRange)
'Перебираем все ячейки заданного диапазона и узнаем их координаты,
'дающие нам смещение от активной ячейки, в которую будет записана сумма
For i = 1 To rng.Cells.Count
r1 = rng.Cells(i).Row
c1 = rng.Cells(i).Column
'Если ячейка с данным смещением имеет цвет шрифта, совпадающий с заданным,
'ее значение включается в сумму
If ActiveCell.Offset(r1 — r, c1 — c).Font.Color = vColor Then
dblSum = dblSum + ActiveCell.Offset(r1 — r, c1 — c).Value
End If
Next i
ColorSum = dblSum
End Function


В дополнение:
Получить число, обозначающее цвет текущей ячейки (для тех, кто на глаз не умеет определять, вроде меня ;-), можно так:

Public Function CellFontColor()
CellFontColor = ActiveCell.Font.Color
End Function

Если в данном диапазоне изменить либо сами цифры, либо цвет на любой другой, то значение в формуле не изменяется сразу, а чтобы оно поменялось, надо нажать, как обычно, F2 и Enter. Тогда формула пересчитается. По крайней мере, у меня так в Office 2000.

Alex Juice, BARCA



Copyright © 2000-2004 Сообщество Чайников
Контактная информация