Трудности в написании (объединении) макроса подходящего для решения задачи подсчета количества отработанных часов в рабочем табеле. В строчке могут быть как черные (рабочие), так и красные (выходные/ночные) цифры. А так же ячейки совмещенные с буквами (например, 2А, А10, Б, К...).
1. Первонаначально используем подсчет суммы по цветам (рабочие и выходные дни)
Код
Public Function СУММЦВЕТ(MyRange As Range, MyCell As Range) As Double
Dim Sum As Double 'Ввод переменной Sum для подсчета суммы
Sum = 0 'Приравнивание переменной Sum к нулю
Application.Volatile True 'Пересчет функции при каком-либо изменении значений ячеек листа
For Each cell In MyRange 'Цикл по всем ячейкам диапазона
If IsNumeric(cell) And cell.Font.Color = MyCell.Font.Color Then 'Проверка текущей ячейки на условие цифры и по цвету
Sum = Sum + cell.Value 'Значение текущей ячейки прибавляется к промежуточной сумме
End If
Next
СУММЦВЕТ = Sum 'Приравнивание возвращаемому результату значение конечной суммы
End Function
2. Подсчет букв (А, Б, Я...) в некоторых ячейках ведем с помощью простой функции =ЕСЛИ(СЧЁТЕСЛИ(диапазон;"Б")=0;"";СЧЁТЕСЛИ(диапазон;"Б"))
3. В некоторых ячейках, помимо числа, стоят совмещенные с буквами (например, 2А, А10, Б, К...). Есть макрос выделения цифры, но только для одной ячейки.
Код
Function GetNumeric(CellRef As String)
Dim StringLength As Integer
StringLength = Len(CellRef)
For i = 1 To StringLength
If IsNumeric(Mid(CellRef, i, 1)) Then Result = Result & Mid(CellRef, i, 1)
Next i
GetNumeric = Result
End Function
ВОПРОС: Можно ли вычленить цифру из текста (3 пункт), что бы они суммировалась с обычными цифрами (1 пункт.). Т.е. объединить эти 2 макроса и вести подсчет количества букв (2 пункт), некоторые из которых, также написаны с цифрами (2А, А10...).
Илья, разбейте свою простынь на соответствующие отдельные темы
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
удачи тогда. потому что сейчас они никак не совместимы, т.к. решают совершенно разные задачи. Сидеть и пытаться их совместить на основании только описания чего вроде бы хотелось бы - дело не благодарное. Ждите, может кому интересно будет воспроизвести данные Вашей таблицы, чтобы подстроить коды под описанный результат.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
удачи тогда. потому что сейчас они никак не совместимы, т.к. решают совершенно разные задачи. Сидеть и пытаться их совместить на основании только описания чего вроде бы хотелось бы - дело не благодарное. Ждите, может кому интересно будет воспроизвести данные Вашей таблицы, чтобы подстроить коды под описанный результат.
а где что считать-то? И какой результат ожидаете? Илья, тянуть по крупинке информацию не самое интересное времяпрепровождение. Мы здесь сидим из интереса и при таком раскладе он с каждым сообщением все меньше и меньше... Поймите правильно - здесь никто не сидит в трепетном ожидании Ваших загадок, чтобы с удовольствием угадывать что, где и как Делайте ставку на то, что большая часть тех, кто зайдет в тему - впервые видят Ваш файл и что где там считается поймут далеко не сразу. Кто-то постарается понять, но большая часть закроет файл и уйдет в другую тему, где реально есть что решать, а не угадывать задачу. Возможно, имелось ввиду это:
Код
Public Function СУММЦВЕТ(MyRange As Range, MyCell As Range) As Double
Dim Sum As Double 'Ввод переменной Sum для подсчета суммы
Sum = 0 'Приравнивание переменной Sum к нулю
Application.Volatile True 'Пересчет функции при каком-либо изменении значений ячеек листа
For Each cell In MyRange 'Цикл по всем ячейкам диапазона
If cell.Font.Color = MyCell.Font.Color Then 'Проверка текущей ячейки на условие цифры и по цвету
Sum = Sum + GetNumeric(cell.Value) 'Значение текущей ячейки прибавляется к промежуточной сумме
End If
Next
СУММЦВЕТ = Sum 'Приравнивание возвращаемому результату значение конечной суммы
End Function
Function GetNumeric(CellRef As String)
Dim StringLength As Integer
StringLength = Len(CellRef)
For i = 1 To StringLength
If IsNumeric(Mid(CellRef, i, 1)) Then Result = Result & Mid(CellRef, i, 1)
Next i
GetNumeric = Result
End Function
но т.к. данных мало - сложно угадать, это ли надо было.
P.S. Если я угадал - мне повезло. На будущее лучше сразу прикладывать файл с текущими результатами и описать, что в этих результатах не устраивает, какой ожидаете и почему.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄