Прописная буква только в начале текста

Выбор из текста всех чисел

Эксперименты с датой

Объединение данных с учетом форматов

Объединение данных диапазона

Разработка и применение полезных пользовательских функций

Листинг 2.45. Функция Couple

Function Couple(Diapazon)

' Объединение данных, содержащихся в ячейках диапазона _

Diapazon (разделитель между значениями - пробел)

' iCell - текущая ячейка

For Each iCell In Diapazon

' Сцепляются данные только заполненных ячеек

If IsEmpty(iCell) <> True Then

' Добавление значения ячейки в выходную строку

If Couple = "" Then

Couple = iCell

Else

Couple = Couple & " " & iCell

End If

End If

Next

End Function

Листинг 2.46. Функция CoupleFormat

Function CoupleFormat(Diapazon)

' Объединение текстовых данных, содержащихся в ячейках _

диапазона Diapazon (разделитель между значениями - пробел)

' iCell - текущая ячейка

For Each iCell In Diapazon

' Сцепляются данные только заполненных ячеек

If IsEmpty(iCell) <> True Then

' Добавление текста ячейки в выходную строку

If CoupleFormat = "" Then

CoupleFormat = iCell.Text

Else

CoupleFormat = CoupleFormat & " " & iCell.Text

End If

End If

Next

End Function

Листинг 2.47. Функция ДатаПолная

Function ДатаПолная(Ячейка)

' Получение данных в заданной ячейке в формате _

"dd mmmm yyyy"

Дата = Format(Ячейка, "dd mmmm yyyy")

If IsDate(Ячейка) = True Or IsDate(Дата) = True Then

' Возврат строки с полной датой

ДатаПолная = StrConv(Дата, vbProperCase)

Else

' Данные в ячейке не являются датой

ДатаПолная = "<>"

End If

End Function

Листинг 2.48. Функция ExtractNumeric

Function ExtractNumeric(iCell)

' Анализируется каждый символ входной строки iCell

For iCount = 1 To Len(iCell)

' Проверка, является ли анализируемый символ числом

If IsNumeric(Mid(iCell, iCount, 1)) = True Then

' Число добавляется в выходную строку

ExtractNumeric = ExtractNumeric & Mid(iCell, iCount, 1)

End If

Next

End Function

Листинг 2.49. Функция ПрописнНач

Function ПрописнНач(Текст)

' Пустой текст функция не обрабатывает

If Текст = "" Then ПрописнНач = "<>": Exit Function

' Выделение первого символа и перевод его в верхний регистр

ПервыйСимвол = UCase(Left(Текст, 1))

' Выделение остальной части строки и перевод _

ее в нижний регистр

Обрубок = LCase(Mid(Текст, 2))

' Соединение частей строки и возврат значения

ПрописнНач = ПервыйСимвол & Обрубок

End Function

Перевод чисел в «деньги»

Листинг 2.50. Функция RubKop

Function RubKop(Число)

' Пустые ячейки и ячейки, содержащие текст, функция _

не обрабатывает

If IsNumeric(Число) = False Or Число = "" Then RubKop = _

"<>": Exit Function

' Из числа целой части - рубли

ДлинаЧисла = Len(Число)

ЦелаяЧасть = Fix(Число)

ДлинаЦелой = Len(ЦелаяЧасть)

' Вычисление длины дробной части

ДлинаДроби = ДлинаЧисла - ДлинаЦелой

If ДлинаДроби <> 0 Then

ДлинаДроби = ДлинаЧисла - ДлинаЦелой - 1

End If

' Формирование количества копеек в зависимости от длины _

дробной части

If ДлинаДроби = 0 Then

' Ноль копеек

Копейки = "00"

ElseIf ДлинаДроби = 1 Then

' Дробная часть состоит из одного числа - это _

десятки копеек

Копейки = Right(Число, ДлинаДроби) & "0"

ElseIf ДлинаДроби = 2 Then

' Дробная часть полностью соответствует количеству копеек

Копейки = Right(Число, ДлинаДроби)

Else

' Длина дробной части больше двух - округлим _

дробную часть

Копейки = Right(Число, ДлинаДроби)

If Mid(Копейки, 3, 1) > 4 Then

Копейки = Left(Копейки, 2) + 1

Else

Копейки = Left(Копейки, 2)

End If

End If

' Составление полной надписи из количества рублей и копеек

Рубли = ЦелаяЧасть

RubKop = Рубли & " " & "руб." & " " & Копейки & " " & "коп."

End Function

Дата добавления: 2015-06-25