Необходима Ваша помощь в создании кода VBA для подсчета кол-ва ячеек. Критерий - тип шрифта (полужирный/курсив/подчеркнутый). Необходимо 3 кода для каждого критерия. Необходимость в 3-х кодах, а не в 1-ом общем связана с тем, что затем эти коды придется объединять для подсчета, например, одновременно по двойному критерию (полужирный + курсив).
Прошу написать коды по примеру следующего кода подсчета кол-ва ячеек по цвету заливки. Т.е. функция будет следующего вида: (диапазон ячеек; адрес ячейки соответствующей критерию).
PublicFunction СЧЁТЗАЛИВКА(ДИАПАЗОН As Range, ЯЧЕЙКА) AsLong Dim S AsDouble Dim rCell As Range Dim ColCell AsLong
ColCell = ЯЧЕЙКА.Interior.Color
S = 0
For Each rCell In ДИАПАЗОН If rCell.Interior.Color = ColCell Then
S = S + 1 EndIf Next
СЧЁТЗАЛИВКА = S EndFunction
Рассчитывая на Вашу помощь, делюсь также с Вами кодом для подсчета кол-ва ячеек по цвету шрифта, а также объединенным кодом для подсчета одновременно по 2-м критериям (цвет заливки + цвет шрифта). Все коды и примеры использования в приложении. Кому интересно и кто не знает, берите, пожалуйста.
P.S. Сам коды писать, к сожалению, не умею Коды для подсчета по цвету заливки, по цвету шрифта мне предоставили на стороне. Объединенный код также помогли сделать.
Уважаемые форумчане!
Необходима Ваша помощь в создании кода VBA для подсчета кол-ва ячеек. Критерий - тип шрифта (полужирный/курсив/подчеркнутый). Необходимо 3 кода для каждого критерия. Необходимость в 3-х кодах, а не в 1-ом общем связана с тем, что затем эти коды придется объединять для подсчета, например, одновременно по двойному критерию (полужирный + курсив).
Прошу написать коды по примеру следующего кода подсчета кол-ва ячеек по цвету заливки. Т.е. функция будет следующего вида: (диапазон ячеек; адрес ячейки соответствующей критерию).
PublicFunction СЧЁТЗАЛИВКА(ДИАПАЗОН As Range, ЯЧЕЙКА) AsLong Dim S AsDouble Dim rCell As Range Dim ColCell AsLong
ColCell = ЯЧЕЙКА.Interior.Color
S = 0
For Each rCell In ДИАПАЗОН If rCell.Interior.Color = ColCell Then
S = S + 1 EndIf Next
СЧЁТЗАЛИВКА = S EndFunction
Рассчитывая на Вашу помощь, делюсь также с Вами кодом для подсчета кол-ва ячеек по цвету шрифта, а также объединенным кодом для подсчета одновременно по 2-м критериям (цвет заливки + цвет шрифта). Все коды и примеры использования в приложении. Кому интересно и кто не знает, берите, пожалуйста.
P.S. Сам коды писать, к сожалению, не умею Коды для подсчета по цвету заливки, по цвету шрифта мне предоставили на стороне. Объединенный код также помогли сделать.Eugen_excel
PublicFunction СЧЁТШРИФТжирный(ДИАПАЗОН As Range) AsLong Dim S AsDouble Dim rCell As Range
S = 0 For Each rCell In ДИАПАЗОН If rCell.Font.Bold = TrueThen
S = S + 1 EndIf Next
СЧЁТШРИФТжирный = S EndFunction
PublicFunction СЧЁТШРИФТкурсив(ДИАПАЗОН As Range) AsLong Dim S AsDouble Dim rCell As Range
S = 0 For Each rCell In ДИАПАЗОН If rCell.Font.Italic = TrueThen
S = S + 1 EndIf Next
СЧЁТШРИФТкурсив = S EndFunction
PublicFunction СЧЁТШРИФТчерта(ДИАПАЗОН As Range) AsLong Dim S AsDouble Dim rCell As Range
S = 0 For Each rCell In ДИАПАЗОН If rCell.Font.Underline = xlUnderlineStyleSingle Then
S = S + 1 EndIf Next
СЧЁТШРИФТчерта = S EndFunction
Добрый день.
PublicFunction СЧЁТШРИФТжирный(ДИАПАЗОН As Range) AsLong Dim S AsDouble Dim rCell As Range
S = 0 For Each rCell In ДИАПАЗОН If rCell.Font.Bold = TrueThen
S = S + 1 EndIf Next
СЧЁТШРИФТжирный = S EndFunction
PublicFunction СЧЁТШРИФТкурсив(ДИАПАЗОН As Range) AsLong Dim S AsDouble Dim rCell As Range
S = 0 For Each rCell In ДИАПАЗОН If rCell.Font.Italic = TrueThen
S = S + 1 EndIf Next
СЧЁТШРИФТкурсив = S EndFunction
PublicFunction СЧЁТШРИФТчерта(ДИАПАЗОН As Range) AsLong Dim S AsDouble Dim rCell As Range
S = 0 For Each rCell In ДИАПАЗОН If rCell.Font.Underline = xlUnderlineStyleSingle Then
S = S + 1 EndIf Next
СЧЁТШРИФТчерта = S EndFunction
@sboy Вы просто гуру Экселя! Спасибо большое! Вы еще сделали, что в формуле нужно указывать только диапазон без необходимости указания ячейки-критерия
Теперь в одной ячейке можно закодировать кучу информации, а вернее загрузить в нее 3 значения: по цвету шрифта, по цвету заливки и по типу шрифта!!
@sboy Вы просто гуру Экселя! Спасибо большое! Вы еще сделали, что в формуле нужно указывать только диапазон без необходимости указания ячейки-критерия
Теперь в одной ячейке можно закодировать кучу информации, а вернее загрузить в нее 3 значения: по цвету шрифта, по цвету заливки и по типу шрифта!!Eugen_excel
Подскажите теперь, пожалуйста, как мне работать с этими функциями, если диапазон состоит из несмежных ячеек? Прописывать для каждой ячейки функцию и все суммировать очень долго.
Подскажите теперь, пожалуйста, как мне работать с этими функциями, если диапазон состоит из несмежных ячеек? Прописывать для каждой ячейки функцию и все суммировать очень долго.Eugen_excel
PublicFunction СЧЁТШРИФТжирный(ДИАПАЗОН As Range) AsLong Dim S AsDouble Dim rCell As Range, da_ As Range
S = 0 For Each da_ In ДИАПАЗОН.Areas For Each rCell In da_ If rCell.Font.Bold = TrueThen
S = S + 1 EndIf Next Next
СЧЁТШРИФТжирный = S EndFunction
Функция пишется вот так
=СЧЁТШРИФТжирный((A1:C9;E4:F6;H9:J16))
Так нужно?
PublicFunction СЧЁТШРИФТжирный(ДИАПАЗОН As Range) AsLong Dim S AsDouble Dim rCell As Range, da_ As Range
S = 0 For Each da_ In ДИАПАЗОН.Areas For Each rCell In da_ If rCell.Font.Bold = TrueThen
S = S + 1 EndIf Next Next
СЧЁТШРИФТжирный = S EndFunction