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

Листинг 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.51. Функция CoincideCount

Function CoincideCount(Text, Search)

' Проверка правильности входных данных _

(аргумента Search)

If IsArray(Search) = True Then Exit Function

If IsError(Search) = True Then Exit Function

If IsEmpty(Search) = True Then Exit Function

' Просмотр заданного в параметре Text диапазона

For Each iCell In Text

' Анализируются только ячейки, содержащие _

корректные значения

If Not IsError(iCell) Then

' iText - строка для просмотра (в нижнем регистре)

iText = LCase(iCell)

' iSearch - искомое значение (в нижнем регистре)

iSearch = LCase(Search)

' Длина искомой строки

iLen = Len(Search)

' Первый поиск строки iSearch в строке iText _

(этот и последующий поиски производятся без _

учета регистра символов)

iNumber = InStr(iText, iSearch)

While iNumber > 0

' Поиск следующего вхождения строки

iNumber = InStr(iNumber + iLen, iText, iSearch)

' Подсчет количества вхождений

CoincideCount = CoincideCount + vbNull

Wend

End If

Next

End Function

Выделение из текста произвольного элемента

Листинг 2.76. Выделение элемента текста

Function dhGetTextItem(ByVal strTextIn As String, intItem As _

Integer, strSeparator As String) As String

Dim intStart As Integer ' Позиция начала текущего элемента

Dim intEnd As Integer ' Позиция конца текущего элемента

Dim i As Integer ' Номер текущего элемента

' Проверка корректности номера элемента

If intItem < 1 Then Exit Function

' Убираются лишние пробелы, если разделитель - пробел

If strSeparator = " " Then strTextIn = Application.Trim(strTextIn)

' Разделитель добавляется в конец строки

If Right(strTextIn, Len(strTextIn)) <> strSeparator Then _

strTextIn = strTextIn & strSeparator

' Поиск всех элементов в строке до нужного

For i = 1 To intItem

' Начало элемента (перемещение вперед по строке)

intStart = intEnd + 1

' Конец элемента

intEnd = InStr(intStart, strTextIn, strSeparator)

If (intEnd = 0) Then

' Дошли до конца строки, но элемент не нашли

Exit Function

End If

Next i

' Выделение текста из входной строки

dhGetTextItem = Mid(strTextIn, intStart, intEnd - intStart)

End Function