оффтоп Дело было вечером, делать было нечего... (с)
Не знаю, пригодится ли это кому-то...
В общем, написал я коротенький код на VBA (тот, который в MSOffice макросах). Код позволяет создавать случайную жеребьевку и по запросу имени дарителя выводит имя одариваемого:
код... Sub тнг()
Dim STArray() As String 'объявляем массив, содержащий треккеров-дарителей
Dim STArray2() As String ' объявляем массив одариваемых треккеров
Dim a As String 'объявлем переменную под служебную строку
Dim x As Integer 'объявляем переменную, содержащую кол-во треккеров
Dim y As Integer 'объявляем переменную-счётчик дарителей
Dim z As Integer 'объявляем переменную-счеткик одариваемых
Dim Numbers() As Variant 'объявлем массив под случайные номера
Dim temp As Integer 'объявляем временную переменную для этих номеров
Dim rnum As Integer 'объявляем другую переменную для этих номеров
Dim nd As String 'объявляем переменную для дарителя
x = InputBox("Введите число треккеров (ЧИСЛО!!!)") 'получаем количество треккеров
a = " дарит подарок " 'служебная строка
'перераспределяем в массивах столько ячеек, сколько треккеров мы получили
ReDim STArray(x)
ReDim STArray2(x)
ReDim Numbers(x)
'Заполняем массив номеров числами
For y = 1 To x
Numbers(y) = y
Next y
Randomize Timer 'инициализируем генератор случайных чисел
' "перемешиваем" числа в массиве
For y = 0 To x
rnum = Int(Rnd * (y) + 1) 'генерируем случайное число и сохраняем в переменную rnum
temp = Numbers(y) 'временно сохраняем элемент массива y в переменную temp
Numbers(y) = Numbers(rnum) 'элементу массива y присваиваем значение элемента rnum
Numbers(rnum) = temp 'элементу массива rnum присваиваем старое значение элемента y из переменной temp
If Numbers(y) = 0 Then
Numbers(y) = 1
End If
Next y
'запускаем цикл, который должен повториться столько раз сколько всего треккеров
For y = 1 To x
'присваеваем каждой ячейке треккера
STArray(y) = InputBox("Ведите треккера под номером " & y)
Next
'делаем массив с рандомизацией треккеров
For y = 1 To x
STArray2(y) = STArray(Numbers(y))
Next
'Выводим пары даритель-одариваемый
For y = 1 To x
nd = InputBox("введите ник дарителя")
For z = 1 To x
If STArray(z) = nd Then
MsgBox nd + a + STArray2(z)
End If
Next
Next
End Sub Скрыть Скрыть