27 Ноябрь 2009

Вывести числа кратные 3 по убыванию с указанием порядковых номеров

Задачи |  Таги: , , , , ,

Вывести числа кратные 3 по убыванию с указанием порядковых номеров

Option Explicit
‘Полное задание:
‘Ввести массив из N натуральных чисел. Из них вывести только числа кратные 3. _
Вывод чисел должен быть по убыванию их значений с указанием порядковых номеров при вводе.
‘Пример.
‘Исходный массив: 6 8 3 5 9 18 4
‘Полученный массив: 18(6) 9(5) 6(1) 3(3)

Private Sub Command1_Click()

Dim i As Long
Dim cnt As Long
Dim cnt2 As Long
Dim ArrLen As Long
Dim bArr() As Variant
Dim aArr() As Variant
Dim cArr() As Variant
Dim dArr() As Variant
Dim bMax As Long

aArr = Array(6, 8, 3, 5, 9, 18, 4) ‘ это заданный массив

ArrLen = UBound(aArr) – LBound(aArr) ‘здесь выч длину заданного массива
ReDim bArr(0 To ArrLen) ‘создаю пустой массив в который введем требуемые элементы
ReDim cArr(0 To ArrLen) ‘ пустой массив с номерами элементов

For i = LBound(aArr) To UBound(aArr) ‘ начинаем считать весь исходный массив
If aArr(i) / 3 = aArr(i) \ 3 Then ‘ если элемент массива делится на 3 без остатка то
bArr(cnt) = aArr(i) ‘ присваиваем этот элемент как новый элемент массива bArr
cArr(cnt) = i ‘ присваиваем позицию элемента новому массиву
cnt = cnt + 1 ‘счетчик для дальнейшего создания массива из нужных элементов (тут мне помогли)
End If
Next i

If cnt Then
ReDim Preserve bArr(0 To cnt – 1) ‘создаем массив из эл-тов что делятся на 3 без остатка
ReDim Preserve cArr(0 To cnt – 1) ‘соответствующие им позиции (порядковые номера)
End If

Sort bArr, cArr ‘ сортируем массив по возрастанию вызывая процедуру (что ниже) сортировки методом пузырька

‘ дальше сортирую новый массив по убыванию и вывожу сразу на форму его с номерами элементов
For i = UBound(bArr) To LBound(bArr) Step -1
Print bArr(i) & «(» & cArr(i) & «)»
Next i

Print «ПОБЕДА!»

End Sub

‘ тут процедура сортировки методом пузырька описывать не буду сами думайте
Sub Sort(Mus() As Variant, Mus2() As Variant)
Dim n As Long, i As Long, j As Long, tmp As Long, tmp2 As Long
i = 0
Do While (i < UBound(Mus))
If Mus(i) > Mus(i + 1) Then
tmp = Mus(i)
tmp2 = Mus2(i)
Mus(i) = Mus(i + 1)
Mus2(i) = Mus2(i + 1)
Mus(i + 1) = tmp
Mus2(i + 1) = tmp2
If i > 1 Then
i = i – 1
Else
i = i + 1
End If
Else
i = i + 1
End If
Loop
End Sub



Оставить комментарий

Я не робот.