Здравствуйте, господа, есть табличка но я ее урезал для наглядности и чтобы не путать. В табличке макрос считает состояние транспорта и другое относительно цвета ячейки. Например трамвай номер ХХХХ цвет зеленый значит исправен и т.д. Но транспорта два типа и в табличке они перепутаны trol и Tram макрос считает их вместе и начальника это устраивало но теперь он хочет знать сколько trol и сколько Tram зеленых синих красных и т.д. Вообщем нужно сделать чтобы макрос также учитывал тип транспорта из колонки E. Заранее спасибо за помощь!
Здравствуйте, господа, есть табличка но я ее урезал для наглядности и чтобы не путать. В табличке макрос считает состояние транспорта и другое относительно цвета ячейки. Например трамвай номер ХХХХ цвет зеленый значит исправен и т.д. Но транспорта два типа и в табличке они перепутаны trol и Tram макрос считает их вместе и начальника это устраивало но теперь он хочет знать сколько trol и сколько Tram зеленых синих красных и т.д. Вообщем нужно сделать чтобы макрос также учитывал тип транспорта из колонки E. Заранее спасибо за помощь!Ex-Sey
Public Function SumColTip(DataRange As Range, ColorSample As Range, KolStolb, TipTransp) As Double 'KolStolb - кол-во столбцов влево (с минусом)/вправо от столбца, где DataRange Dim Sum As Double, Cell_ As Range Application.Volatile True col_ = ColorSample.Interior.Color For Each Cell_ In DataRange With Cell_ If .Offset(, KolStolb) = TipTransp Then If .Interior.Color = col_ Then Sum = Sum + 1 End If End If End With Next Cell_ SumColTip = Sum End Function
[/vba]
Так нужно? [vba]
Код
Public Function SumColTip(DataRange As Range, ColorSample As Range, KolStolb, TipTransp) As Double 'KolStolb - кол-во столбцов влево (с минусом)/вправо от столбца, где DataRange Dim Sum As Double, Cell_ As Range Application.Volatile True col_ = ColorSample.Interior.Color For Each Cell_ In DataRange With Cell_ If .Offset(, KolStolb) = TipTransp Then If .Interior.Color = col_ Then Sum = Sum + 1 End If End If End With Next Cell_ SumColTip = Sum End Function
Скопировать макрос из сообщения Альт+F11 Найти свой файл в окошке ВБАПроджект Топать на плюсяки в нем пока не увидите "Модуль1" Даблкликнуть на него, он откроется в большом окне. Стереть там функцию и вставить скопированное
Или наоборот, скачать мой файл из предыдущего сообщения и работать в нем. Там уже все настроено
Скопировать макрос из сообщения Альт+F11 Найти свой файл в окошке ВБАПроджект Топать на плюсяки в нем пока не увидите "Модуль1" Даблкликнуть на него, он откроется в большом окне. Стереть там функцию и вставить скопированное
Или наоборот, скачать мой файл из предыдущего сообщения и работать в нем. Там уже все настроено_Boroda_
Не заметил. Тогда не удаляйте ту функцию, что была. Вернее не, ту удалите, а вот эту заместо нее напишите [vba]
Код
Public Function SumByColor(DataRange As Range, ColorSample As Range) As Double Dim Sum As Double Application.Volatile True col_ = ColorSample.Interior.Color For Each Cell In DataRange If Cell.Interior.Color = col_ Then Sum = Sum + 1 End If Next Cell SumByColor = Sum End Function
[/vba]
Не заметил. Тогда не удаляйте ту функцию, что была. Вернее не, ту удалите, а вот эту заместо нее напишите [vba]
Код
Public Function SumByColor(DataRange As Range, ColorSample As Range) As Double Dim Sum As Double Application.Volatile True col_ = ColorSample.Interior.Color For Each Cell In DataRange If Cell.Interior.Color = col_ Then Sum = Sum + 1 End If Next Cell SumByColor = Sum End Function
Можно. А зачем? Тем более, что ту функцию я переписал немного - она считала цвет-шаблон для каждой итерации, а у меня он считается один раз. Считывание раскрасок - довольно энергоемкая и длительнвая операция
Можно. А зачем? Тем более, что ту функцию я переписал немного - она считала цвет-шаблон для каждой итерации, а у меня он считается один раз. Считывание раскрасок - довольно энергоемкая и длительнвая операция_Boroda_