Страницы: 1
RSS
Суммирование по подчеркнутому шрифту.
 
Друзья, составляю табель, почти уже полностью сформировал формулы. Остается один штрих. Бьюсь уже дня 2. Никак не могу составить макрос для подсчета суммы значений в ячейках по подчернутым цифрам. Дело в том что ночные часы отмечаются именно так, подчеркиванием. Один раз получилось сформировать макрос, но увы автоматического пересчета так и не добился. Дело в том что посчет идет лишь когда копирую ячейки с подчеркнутыми цифрами и вставляю туда куда нужно. Как возможно сделать чтобы автоматически происходил подсчет, когда ввожу вручную время и подчеркиваю? По клавише F9 макрос этот не запускается.
Может макрос неправильно составил. Подскажите.
Код
Function СЧЁТШРИФТчерта(ДИАПАЗОН As Range) As Double
    Dim S As Double
    Dim rCell As Range
    S = 0
    For Each rCell In ДИАПАЗОН
        If rCell.Font.Underline = xlUnderlineStyleSingle Then
            S = S + rCell.Value
        End If
    Next
    СЧЁТШРИФТчерта = S
End Function
 
Цитата
evgenij_sar написал: Может макрос неправильно составил
То, что Вы составили, называется Пользовательская функция (UDF), частный случай макроса. Она срабатывает так же как и штатные функции листа.
'Повесьте' Ваш макрос на обработчик события листа Change
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
'Повесьте' Ваш макрос на обработчик события листа Change
Чувствую подвох, и даже знаю где он :-)
По вопросам из тем форума, личку не читаю.
 
Я не очень силен в Excel если честно, но думаю знаю о чем Вы говорите.
Открыл лист, в левом поле выбрал Worksheet, в правом Change
Правильно ли вставил формулу?
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Function СЧЁТШРИФТчерта(ДИАПАЗОН As Range) As Double
    Dim S As Double
    Dim rCell As Range
    S = 0
    For Each rCell In ДИАПАЗОН
        If rCell.Font.Underline = xlUnderlineStyleSingle Then
            S = S + rCell.Value
        End If
    Next
    СЧЁТШРИФТчерта = S
End Function
Изменено: evgenij_sar - 02.02.2019 16:50:04
 
Цитата
evgenij_sar написал: Правильно ли вставил формулу?
Нет, не правильно. И, как правильно заметил БМВ, в таком подходе тоже есть подвох, т.к. само по себе событие подчеркивания текста не отслеживается.
Прикрепите файл-пример. Как есть - Как надо
Согласие есть продукт при полном непротивлении сторон
 
Код
Function f() 
 Application.Volatile 

...' ваш код

End Function

не помогает?
Соблюдение правил форума не освобождает от модераторского произвола
 
К сожалению. При добавлении кода вперед формулы, один раз позволяет сделать пересчет нажатием F9
 
Цитата
evgenij_sar написал:
Дело в том что ночные часы отмечаются именно так, подчеркиванием
Это визуализация, наверно есть признак по которому это подчеркивают, и именно на него надо делать опору.
По вопросам из тем форума, личку не читаю.
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Function СЧЁТШРИФТчерта(ДИАПАЗОН As Range) As Double
   Dim S As Double
   Dim rCell As Range
   S = 0
   For Each rCell In ДИАПАЗОН
       If rCell.Font.Underline = xlUnderlineStyleSingle Then
           S = S + rCell.Value
       End If
   Next
   СЧЁТШРИФТчерта = S
End Function
 
Цитата
БМВ написал:
Это визуализация, наверно есть признак по которому это подчеркивают, и именно на него надо делать опору.
Это в большей мере даже не то чтобы визуализация, а так составлен оригинальный бланк табель. И на печать он выходить должен именно так. С подчеркнутыми ночными часами.
Самое интересное что макрос срабатывает когда удаляю данные с этих ячеек и вставляю скопировав с других полей числа подчеркнутые.
Когда вставляю без подчеркивания то не работает. Т.е. по сути надо лишь чтобы считал когда редактируется ячейка в ручную.
Изменено: evgenij_sar - 02.02.2019 16:55:30
 
Я не советую отменить визуализацию. Я говорю о том, что подсчет надо вести по другому признаку.
По вопросам из тем форума, личку не читаю.
 
Может тогда подскажите как правильно вставить формулу в лист
Код
Private Sub Worksheet_Change(ByVal Target As Range)
.....?......
End Function
 
А подсказка от buchlotnik, не помогла? Замените свою функцию на такую
Код
Function СЧЁТШРИФТчерта(ДИАПАЗОН As Range) As Double
Application.Volatile
   Dim rCell As Range
   For Each rCell In ДИАПАЗОН
       If rCell.Font.Underline = xlUnderlineStyleSingle Then
           СЧЁТШРИФТчерта = СЧЁТШРИФТчерта + rCell.Value
       End If
   Next
End Function
Согласие есть продукт при полном непротивлении сторон
 
CTRL+C, CTRL+V - это конечно шутка.
Без принудительного пересчета листа UDF работать не будут, также как и никакой макрос не сработает автоматом при форматировании ячейки.
Если будет пример файла и описание критериев, по которым кто-то руками подчеркивает ночные часы, то может и подчеркивать можно не руками, а автоматом, и считать тоже можно простыми формулами.
По вопросам из тем форума, личку не читаю.
 
Цитата
Sanja написал:
Замените свою функцию на такую
Отлично!!! Спасибо огромное! Все получилось! Теперь пересчет идет через клавишу F9. В принципе этого достаточно!
 
Цитата
БМВ написал:
подсчет надо вести по другому признаку
Вероятно имеется ввиду - кто и когда подчеркивает ячейки по ночам)
Sanja, Volatile просто так не поможет при подчеркивании - что-то должно вызвать пересчет, что, впрочем подтверждается в #8
 
Да макрос от Sanja вполне помог! За что ему большое спасибо! Этого куда предостаточно. Сначала составил, подчеркнул по табелю ночные и нажал на F9.
Самое то!
 
Тогда уж добавить нужно пересчет перед печатью и перед сохранением книги, на случай когда забудут нажать на F9 , а обязательно забудут когда-либо.
По вопросам из тем форума, личку не читаю.
 
Кстати говоря да. Так как обычно будут люди копировать с ячеки в ячейку перерасчет будет занимать время. Лучше отменить автоматический расчет и сделать или в ручную или все таки перед закрытием. Подскажите как это выполнить? Придется лезть опять в листы и ставить workbook? Как вставить макросы в лист?
 
evgenij_sar,  Может все ж в теме появится этот тайно подчеркнутый в ночи табель с критерием что считать ночными часами?
По вопросам из тем форума, личку не читаю.
 
Всем спасибо! Оказывается все куда проще! Шаманство в настройках, отключил автомат и поставил галку на вручную и перед сохранением!
 
Цитата
evgenij_sar написал:
Шаманство в настройках, отключил автомат и поставил галку на вручную и перед сохранением!
Удивительное дело, и так и так вроде советуешь, а грабли все равно найдут.

evgenij_sar, Настройка автопересчета в результате будет отключена для всех книг. Уверены что потом в другом файле это не приведет к сюрпризу?
А печатать будут только после сохранение? Ну как знаете. только не говорите что Вас не предупреждали.
По вопросам из тем форума, личку не читаю.
 
И, если в современных версиях этого не исправили, то открытие файла, который был сохранен с отключенными вычислениями, отключает вычисления в Excel. Так что грабли с топором...
 
Цитата
Alec Perle написал:
если в современных версиях этого не исправили,
Пока нет.
Владимир
 
и не исправят ибо это обрушит некоторые взаимосвязи, я не говорю о обратой совместимости. Допустим свойство Calculate перенесли из Application в WorkBoоk или ….. Если будет связка Book1-Book2-Book1, то  при изменении в Book1 как обновится Book2 если там ручной пересчет? А если не пересчиталось там, то и обратно вернется не пересчитанным в Book1- на выходе некорректный расчет.

Попытка посчитать подчеркнутое напоминает: Мыши плакали, кололись, но продолжали есть кактус.
По вопросам из тем форума, личку не читаю.
 
Цитата
evgenij_sar написал:
Сначала составил, подчеркнул по табелю ночные и нажал на F9
Тогда не логичней повесить макрос, который проведет нужные вычисления и запишет из в ячейку, на кнопку, и нажимать ее когда надо пересчитать
 
Для успокоения души, вернул настройки на место и в лист добавил и вуаля! Всё великолепно.
:)
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.CalculateBeforeSave = True
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
 For Each wk In Worksheets
 wk.Calculate
 Next
End Sub
Изменено: evgenij_sar - 02.02.2019 20:54:17
Страницы: 1
Наверх