Здравствуйте! Поставленная задача, как мне кажется, решается только с помощью макросов. В строке итогов таблицы должны отобразиться значения, которые содержатся в примере. Не прошу решать всю задачу за меня, подскажите пожалуйста, как в VBA обратиться к отдельным ячейкам нужного столбца таблицы, а там поди смогу организовать цикл, в котором пройдусь по столбцу и подсчитаю интересующие меня значения. Заранее спасибо! [img][/img]
Здравствуйте! Поставленная задача, как мне кажется, решается только с помощью макросов. В строке итогов таблицы должны отобразиться значения, которые содержатся в примере. Не прошу решать всю задачу за меня, подскажите пожалуйста, как в VBA обратиться к отдельным ячейкам нужного столбца таблицы, а там поди смогу организовать цикл, в котором пройдусь по столбцу и подсчитаю интересующие меня значения. Заранее спасибо! [img][/img]iraci
Выделение жирным шрифтом и "маскировка" бледным происходят посредством макроса. Логика в данном случае не имеет никакого значения и она столь заковыриста, что для ее изложения нужно описывать практически всю предметную область, что вряд ли интересно, но точно довольно трудоемко. Макрос выделил нужные ячейки в таблице, а теперь нужно посчитать количество этих выделенных ячеек в каждом столбце. Вот здесь я и застряла, поскольку не нашла примера, как в макросе можно обратиться к конкретной строке конкретного столбца встроенной таблицы С макросами знакома недавно, может мою задачу можно решить иначе, чем я предполагаю. Но как?
Выделение жирным шрифтом и "маскировка" бледным происходят посредством макроса. Логика в данном случае не имеет никакого значения и она столь заковыриста, что для ее изложения нужно описывать практически всю предметную область, что вряд ли интересно, но точно довольно трудоемко. Макрос выделил нужные ячейки в таблице, а теперь нужно посчитать количество этих выделенных ячеек в каждом столбце. Вот здесь я и застряла, поскольку не нашла примера, как в макросе можно обратиться к конкретной строке конкретного столбца встроенной таблицы С макросами знакома недавно, может мою задачу можно решить иначе, чем я предполагаю. Но как? iraci
Сообщение отредактировал iraci - Четверг, 21.09.2017, 22:11
Я думала об этом, но это получится "в Абашево через Колпашево" - бессмысленное многократное усложнение код макроса. Макрос "обрабатывает" одну строку и со своей специализированной задачей справляется. Здесь же нужно проработать столбец. Две разные задачи, да и использовать их придется по отдельности: добавляется в таблицу строка - ее "обслуживает" один макрос, после всех внесенных обновлений и дополнений запускается второй, который подводит итог, подсчитывая количество интересующих его значений.
Я думала об этом, но это получится "в Абашево через Колпашево" - бессмысленное многократное усложнение код макроса. Макрос "обрабатывает" одну строку и со своей специализированной задачей справляется. Здесь же нужно проработать столбец. Две разные задачи, да и использовать их придется по отдельности: добавляется в таблицу строка - ее "обслуживает" один макрос, после всех внесенных обновлений и дополнений запускается второй, который подводит итог, подсчитывая количество интересующих его значений.iraci
iraci, Незнаю насколько оптимально, но как вариант:
[vba]
Код
Sub Макрос2() Application.ScreenUpdating = False lcol = Cells(1, 1).End(xlToRight).Column For i = 1 To lcol Set Rng = Range("Таблица14[" & Cells(1, i) & "]") 'Имя таблицы меняем на своё Set Itog = Range("Таблица14[[#Totals],[" & Cells(1, i) & "]]") j = 0 For Each cl In Rng If cl.Font.Bold = True Then j = j + 1 Next Itog.Value = j Next Application.ScreenUpdating = True End Sub
[/vba]
Цитата
бессмысленное многократное усложнение код макроса.
Как сказать, рациональнее прикрутить счётчик к макросу который обрабатывает ваши диапазоны, чем циклом перебирать весь диапазон заново.
iraci, Незнаю насколько оптимально, но как вариант:
[vba]
Код
Sub Макрос2() Application.ScreenUpdating = False lcol = Cells(1, 1).End(xlToRight).Column For i = 1 To lcol Set Rng = Range("Таблица14[" & Cells(1, i) & "]") 'Имя таблицы меняем на своё Set Itog = Range("Таблица14[[#Totals],[" & Cells(1, i) & "]]") j = 0 For Each cl In Rng If cl.Font.Bold = True Then j = j + 1 Next Itog.Value = j Next Application.ScreenUpdating = True End Sub
[/vba]
Цитата
бессмысленное многократное усложнение код макроса.
Как сказать, рациональнее прикрутить счётчик к макросу который обрабатывает ваши диапазоны, чем циклом перебирать весь диапазон заново.Shurf
Да мне не жалко)) только код привязан к реальному файлу, не примеру (файл нельзя выложить). В файле на данный момент два макроса, выполняющие свои задачи. Первый выполняет некоторые преобразования и рассчитывает нужные даты: [vba]
Код
Sub Преобразование_ДР_Расчет_дат() ' Работает в пределах одной строки. Сочетание клавиш: Ctrl+ф
Dim Month_ As Integer Dim Year_ As Integer Dim DatDR As Date Dim DatNew As Date
' преобразуем д/р в последний день месяца рождения ' чтобы рассчитать кол-во полных лет и мес на 01 число DatDR = Cells(ActiveCell.Row, ActiveCell.Column).Value Month_ = Month(DatDR) Year_ = Year(DatDR) If Month_ = 12 Then Month_ = 1 Year_ = Year_ + 1 Else Month_ = Month_ + 1 End If
Второй макрос отвечает за изменение шрифта в зависимости от ряда условий и вызывается в теле первого макроса, после того как тот отработает свои задачи [vba]
Код
Sub Диапазоны()()
Dim Full_Month As Integer Dim Full_Year As Integer Dim DatDR_Change As Date Dim DatDR As Date
'Диапазон <= 3 If Full_Year < 3 Or (Full_Year = 3 And Full_Month < 1) Then Cells(ActiveCell.Row, ActiveCell.Column + 3).Font.ColorIndex = 1 Cells(ActiveCell.Row, ActiveCell.Column + 3).Font.Bold = True Else: Cells(ActiveCell.Row, ActiveCell.Column + 3).Font.ColorIndex = 40 Cells(ActiveCell.Row, ActiveCell.Column + 3).Font.Bold = False End If
'Диапазон > 3 и < 10 If ((Full_Year > 3) Or (Full_Year = 3 And Full_Month > 0)) And (Full_Year < 10 Or (Full_Year = 10 And Full_Month < 0)) Then Cells(ActiveCell.Row, ActiveCell.Column + 4).Font.ColorIndex = 1 Cells(ActiveCell.Row, ActiveCell.Column + 4).Font.Bold = True Else: Cells(ActiveCell.Row, ActiveCell.Column + 4).Font.ColorIndex = 40 Cells(ActiveCell.Row, ActiveCell.Column + 4).Font.Bold = False End If
'Диапазон >= 10 и <= 18 If (Full_Year > 10 Or (Full_Year = 10 And Full_Month > (-1))) And (Full_Year < 18 Or (Full_Year = 18 And Full_Month < 1)) Then Cells(ActiveCell.Row, ActiveCell.Column + 5).Font.ColorIndex = 1 Cells(ActiveCell.Row, ActiveCell.Column + 5).Font.Bold = True Else: Cells(ActiveCell.Row, ActiveCell.Column + 5).Font.ColorIndex = 40 Cells(ActiveCell.Row, ActiveCell.Column + 5).Font.Bold = False End If
'Диапазон > 18 <= 20 If Cells(ActiveCell.Row, ActiveCell.Column + 9).Value <> "" And (((Full_Year > 18) Or (Full_Year = 18 And Full_Month > 0)) And (Full_Year < 20 Or (Full_Year = 20 And Full_Month < 1))) Then Cells(ActiveCell.Row, ActiveCell.Column + 8).Font.ColorIndex = 1 Else: Cells(ActiveCell.Row, ActiveCell.Column + 8).Font.ColorIndex = 40 End If
'Диапазон > 18 <= 23 If Cells(ActiveCell.Row, ActiveCell.Column + 11).Value <> "" And (((Full_Year > 18) Or (Full_Year = 18 And Full_Month > 0)) And (Full_Year < 23 Or (Full_Year = 23 And Full_Month < 1))) Then Cells(ActiveCell.Row, ActiveCell.Column + 10).Font.ColorIndex = 1 Else: Cells(ActiveCell.Row, ActiveCell.Column + 10).Font.ColorIndex = 40 End If
End Sub
[/vba]
а мне нужен еще третий макрос, который в нужном столбце подсчитал бы количество интересующих меня дат, выделенных жирным черным шрифтом
Да мне не жалко)) только код привязан к реальному файлу, не примеру (файл нельзя выложить). В файле на данный момент два макроса, выполняющие свои задачи. Первый выполняет некоторые преобразования и рассчитывает нужные даты: [vba]
Код
Sub Преобразование_ДР_Расчет_дат() ' Работает в пределах одной строки. Сочетание клавиш: Ctrl+ф
Dim Month_ As Integer Dim Year_ As Integer Dim DatDR As Date Dim DatNew As Date
' преобразуем д/р в последний день месяца рождения ' чтобы рассчитать кол-во полных лет и мес на 01 число DatDR = Cells(ActiveCell.Row, ActiveCell.Column).Value Month_ = Month(DatDR) Year_ = Year(DatDR) If Month_ = 12 Then Month_ = 1 Year_ = Year_ + 1 Else Month_ = Month_ + 1 End If
Второй макрос отвечает за изменение шрифта в зависимости от ряда условий и вызывается в теле первого макроса, после того как тот отработает свои задачи [vba]
Код
Sub Диапазоны()()
Dim Full_Month As Integer Dim Full_Year As Integer Dim DatDR_Change As Date Dim DatDR As Date
ой, что это у меня получилось? как тут корректно вставить код макроса Простите за ужасный вид кода, попытаюсь разобраться, почему так получилось((
ой, что это у меня получилось? как тут корректно вставить код макроса Простите за ужасный вид кода, попытаюсь разобраться, почему так получилось((iraci
Сообщение отредактировал iraci - Пятница, 22.09.2017, 09:21
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
С макросами знакома недавно, может мою задачу можно решить иначе, чем я предполагаю. Но как? 
