Помогите с созданием функции плиз

[IgorGO]

Вот задание:
Нужно написать функцию которая бы для диапазона,передаваемого её в качестве параметра находила бы количество чисел,состоящих только из нечетных цифр.

Функция называется HowOdd. Написал в соответствии с заданием. В ячейке А1 видно, как эта функция работает. Чтобы было нагляднее видно что она посчитала - я при помощи условного форматирования закрасил "правильные" ячейки.
Если Ваши данные скопировать в высланную мною книгу, и указать нужный диапазон - то в код можно и не смотреть. Условные форматы можно снести.
Либо: необходимо копировать код функций HowOdd и AllOdd в модуль Вашего листа, и там пользоваться функцией HowOdd.

а понимать там все просто:
1 Function HowOdd(r As Range) As Long
2 Dim cell
3 Dim how As Long
4 how = 0
5 For Each cell In r
6 If AllOdd(cell.Value) Then how = how + 1
7 Next
8 HowOdd = how
9 End Function
Комментирую по строчкам:
1:обьявлена функция. получает диапазон в качестве параметра, возвращает число
2,3: обьявлены внутренные переменные
4: начальное количество "правильных" ячеек равно 0
5:цикл для всех ячеек полученного как параметр диапазона
6:если в ячейке только нечетные цифры увеличиваем количество правильных на 1
7:след.ячейка, или конец цикла
8:присваиваем результат
9:конец функции


1 Function AllOdd(r As Long) As Boolean
2 Dim i As Integer
3 s = LTrim(Str(r))
4 i = 1
5 AllOdd = False
6 Do
7 If Not WorksheetFunction.IsOdd(Val(Mid(s, i, 1))) Then Exit Function
8 i = i + 1
9 Loop Until i > Len(s)
10 AllOdd = True
11 End Function

1: функция получает число, и возвращает ИСТИНА, когда все нечетные
2: обьявляем переменную (пройдемся по всем цифрам)
3: переводим число в строку (+убиваем пробелы слева)
4: начнем с первого символа
5: функция = ЛОЖЬ
6: заворачивается цикл до условия см. строку 9
7: если i-й символ четный прекращаем рассматривать строку, она уже не "правильная"
8: будем изучать следующий символ
9: цикл крутится пока номер след.символа не станет больше длины строки
10:ни разу не оборвалось рассмотрение строки, и дошли до ее конца - значит все Ок!
11: кончилась функция

[Sergmodern]

Спасибо Вам огромное за помощь,все получилось,без Вас бы я точно бы пропал!!!

[Sergmodern]

Но у меня тут проблемка маленькая вышла,вообщем ввожу я колледже на компьютере весь код как по примеру выше,запускаю макрос,затем использую ф-ю howodd и он не считает ничего,пишет,что

6 Do
7 If Not WorksheetFunction.IsOdd(Val(Mid(s, i, 1))) Then Exit Function
8 i = i + 1
9 Loop Until i > Len(s)

якобы этот метод не совместим,может это как-то связано с версиями Экселей,то в колледже 2003,а эта ф-я отлично работает в 2007,как можно эту ошибку в 2003 избежать?Может в 2003 надо что-то перенастроить?

[IgorGO]

если во время выполнения возникнет ошибка в теле макроса (а в это время будет открыт редактор ВБА) у вас должно появиться окно с вопросом как поступить с макросом "остановить выполнение" или перейти к отладке (End, Debug). переходим к отладке:
1. Видим в какой строке прозошла ошибка
2. Можем проверить значения переменных и определиться что происходит не так.

Есть подозрение на WorksheetFunction.IsOdd, но у меня нет 2003 и я не проверю. Раньше функция проверки на четность (или нечетность) вроде была в ВБА, искал специально под эту задачу - не нашел, был сильно озадачен, поэтому воспользовался функцией листа IsOdd.

можно вот это:
If Not WorksheetFunction.IsOdd(Val(Mid(s, i, 1))) Then Exit Function
заменить на такое
If Not ((Val(Mid(s, i, 1)) and 1) = 1) Then Exit Function
и запись короче, и от функции листа ушли.

[Sergmodern]

спасибо,сейчас проверю на 2003.

[Sergmodern]

Проверил,установил 2003 и он теперь ругается на вот это
For Each cell In r
===========> If AllOdd(cell.Value) Then how = how + 1
Next

Type mismatch.
В чем может быть проблема?Boolean не подходит.Опять этот мелкософт нехочет ничего делать.

[IgorGO]

в ячейках должны быть целочисленные значения. если там действительное число или текст - возможен Type mismatch.

Опять этот мелкософт нехочет ничего делать.

мелкософт вручил в руки мощный инструмент. и если кто-то не умеет им пользоваться - это проблема не мелклсофта, увы...

[КаМММ]

А как ошибочные сообщения удалять?
А то ляпнул тут а стереть не могу.

[Sergmodern]

IgorGo а в вашем примере генерируемые значения целочисленные?Но когда я ввожу свои значения то у меня в ячейках пишется знач.А там все равно мисмач.

[IgorGO]

Да, в примере генерируются целые цисла.
В инете можно почитать что такое натуральные, целые, действительные, рациональные и другие числа.
Функция написанная мною не учитывает никаких ошибок. Предполагается что в ячейке должен быть любой набор цифр от 0 до 9 в любой последовательности. Наличие каких-либо других знаков исключено, вызовет ошибку выполнения функции. В принципе, все сказано в ячейке допускаются только символы от "0" до "9".

Вобщем рассказывать дольше чем подправить функцию.

Function AllOdd(r) As Boolean
  Dim i As Integer, s As String
  On Error Resume Next
  s = LTrim(Str(r))
  If Error = "Type mismatch" Then Exit Function
  i = 1
  AllOdd = False
  Do
    If (Val(Mid(s, i, 1)) And 1) = 1 Then i = i + 1 Else Exit Function
  Loop Until i > Len(s)
  AllOdd = True
End Function