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

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

FunctiondhGetTextItem(ByValstrTextInAsString,intItemAs_

Integer, strSeparator As String) As String

DimintStartAsInteger' Позиция начала текущего элемента

DimintEndAsInteger' Позиция конца текущего элемента

DimiAsInteger' Номер текущего элемента

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

IfintItem< 1ThenExitFunction

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

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

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

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

strTextIn=strTextIn&strSeparator

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

Fori= 1TointItem

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

intStart = intEnd + 1

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

intEnd = InStr(intStart, strTextIn, strSeparator)

If(intEnd= 0)Then

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

Exit Function

End If

Next i

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

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

EndFunction

Генератор случайных чисел

Листинг 2.77.Функция dhGetRandomValues

Function dhGetRandomValues() As Variant

Dim intRow As Integer ' Номер текущей строки

Dim intCol As Integer ' Номер текущего столбца

DimaintOut()AsInteger' Выходной массив (двумерный)

DimaintValues()AsInteger' Массив с возможными значениями

DimintMaxAsInteger' Последний доступный элемент массива _

aintValues

Dim i As Integer

ReDim aintOut(1 To Application.Caller.Rows.Count, 1 To _

Application.Caller.Columns.Count)

' Всего нужно чисел...

intMax = Application.Caller.Rows.Count * _

Application.Caller.Columns.Count

ReDim aintValues(1 To intMax)

' Заполнение массива aintValuesзначениями от 1 доintMax

For i = 1 To intMax

aintValues(i) = i

Nexti

' Занесение значений в выходной массив aintOut, в произвольном _

порядке выбирая их из aintValues

Randomize

For intRow = 1 To Application.Caller.Rows.Count

For intCol = 1 To Application.Caller.Columns.Count

' Определение номера элемента из aintValues

i = Rnd * intMax

If i = 0 Then i = 1

' Занесение этого элемента в выходной массив

aintOut(intRow, intCol) = aintValues(i)

' Уменьшение массива aintValues(то есть еще один его _

элемент выбран) - замена выбранного элемента последним _

в массиве

aintValues(i) = aintValues(intMax)

intMax = intMax - 1

Next intCol

Next intRow

' Возвращение массива значений

dhGetRandomValues=aintOut

EndFunction

Случайные числа — на основании диапазона

Листинг 2.78. Функция dhGetRandomValues1

Function dhGetRandomValues1(rgSource As Range) As Variant

Dim intRow As Integer ' Номер текущей строки

Dim intCol As Integer ' Номер текущего столбца

DimavarOut()AsVariant' Выходной массив (двумерный)

DimavarValues()AsVariant' Массив с возможными значениями

DimintValCountAsInteger' Количество возможных значений

Dim cell As Range

Dim i As Integer

ReDim avarOut(1 To Application.Caller.Rows.Count, 1 To _

Application.Caller.Columns.Count)

' Всего нужно чисел...

intValCount = rgSource.Rows.Count * rgSource.Columns.Count

ReDimavarValues(1TointValCount)

' Заполнение массива avarValuesзначениями из указанного _

диапазона

For Each cell In rgSource

i = i + 1

avarValues(i) = cell.Value

Nextcell

' Занесение значений в выходной массив avarOut, в произвольном _

порядке выбирая их из avarValues

Randomize

For intRow = 1 To Application.Caller.Rows.Count

For intCol = 1 To Application.Caller.Columns.Count

' Определение номера элемента из avarValues

i = Rnd * intValCount

If i = 0 Then i = 1

' Занесение этого элемента в выходной массив

avarOut(intRow, intCol) = avarValues(i)

NextintCol

NextintRow

' Возвращение массива значений

dhGetRandomValues1 = avarOut

End Function