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

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

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

Листинг 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

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

Function dhGetRandomValues() As Variant

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

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

Dim aintOut() As Integer ' Выходной массив (двумерный)

Dim aintValues() As Integer ' Массив с возможными значениями

Dim intMax As Integer ' Последний доступный элемент массива _

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

Next i

' Занесение значений в выходной массив 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

End Function

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

Function dhGetRandomValues1(rgSource As Range) As Variant

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

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

Dim avarOut() As Variant ' Выходной массив (двумерный)

Dim avarValues() As Variant ' Массив с возможными значениями

Dim intValCount As Integer ' Количество возможных значений

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

ReDim avarValues(1 To intValCount)

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

диапазона

For Each cell In rgSource

i = i + 1

avarValues(i) = cell.Value

Next cell

' Занесение значений в выходной массив 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)

Next intCol

Next intRow

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

dhGetRandomValues1 = avarOut

End Function

Глава 3. Создание трюков с помощью макросов

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