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