RE: решила интересную задачку, но её надо немного подредактировать

bazile — Mon, 02 Apr 2007 12:35:17 GMT

lapulechka, большая просьба, в будущем указывать тему сообщения, а не оставлять ее пустой.

решила интересную задачку, но её надо немного подредактировать

lapulechka — Mon, 02 Apr 2007 10:46:51 GMT

Задачка была такая:

Найти наименьшее общее кратное 3 заданных натуральных чисел.

Надо переделать без массивов и чтобы эти 3 числа можно было вводить в Text Box.

А я решила вот так:

Option Base 1
Option Explicit
'определение трёх глобальных динамических массивов, в которых будут храниться множители
Dim tA() As Integer, tB() As Integer, tC() As Integer

Private Sub Form_Load()
'Найти наименьшее общее кратное 3 заданных натуральных чисел.
'Integer -- -32,768 .. 32,767
'Currency (scaled integer) -- -922,337,203,685,477.5808 .. 922,337,203,685,477.5807
Dim a As Integer, b As Integer, c As Integer, i As Integer, s As Currency

'инициализация переменных... Задаём 3 натуральных числа
a = 7
b = 17
c = 34

'начинается поиск множителей НОК трёх чисел
Call srcNOK(a, b, c)

'перемножение найденных множителей
s = 1

For i = 1 To UBound(tA)

s = s * tA(i)

Next i

'Form1.Hide

'результат перемножения выводится на экран
MsgBox s, vbOKOnly + vbInformation, "Результат"

'выход из программы
End

End Sub

Sub srcNOK(ByVal a As Integer, ByVal b As Integer, ByVal c As Integer)

'проверка исходных данных
'если числа не натуральные, выдаётся сообщение об ошибке и производится выход из программы
If (a < 1) Or (b < 1) Or (c < 1) Then MsgBox "Wrong values": Exit Sub

'инициализация массивов
ReDim tA(1): tA(1) = 1
ReDim tB(1): tB(1) = 1
ReDim tC(1): tC(1) = 1

'заполнение массивов множителями соответствующих чисел
Call fillArray(a, tA)
Call fillArray(b, tB)
Call fillArray(c, tC)

'сравнение множителей чисел a и b
'результат -- множители НОК -- будет сохранён в массиве tA
Call cmpArr(tA, tB)
'сортировка массива tA
Call sortArr(tA)
'сравнение промежуточного результата (массив tA) с массивом множителей числа c
Call cmpArr(tA, tC)

End Sub

'ищутся множители числа
Sub fillArray(ByVal n As Integer, ByRef tN() As Integer)
Dim i As Integer, k As Integer

i = 2
k = 2

Do While (n > 1) And (i <= n)

If (n Mod i) = 0 Then

'если число без остатка делится на текущее значение
'целочисленной переменной i,
'значит i -- один из множителей числа
ReDim Preserve tN(k)
tN(k) = i
k = k + 1

'далее проверяется результат деления числа на множитель
n = n / i

'целочисленная переменная i инициализируется заново
i = 2

Else

'если число не делится на i, переходим к следующему i
i = i + 1

End If

Loop

End Sub

'сравнение массивов
Sub cmpArr(ByRef tN1() As Integer, ByRef tN2() As Integer)
Dim i1 As Integer, i2 As Integer, k As Integer, j As Integer

'инициализация индексов массивов
i1 = 1
i2 = 1

Do While (i1 <= UBound(tN1)) And (i2 <= UBound(tN2))

'если элементы массивов (множители) одинаковы,
'элемент второго массива зануляется,
'производится переход к следующим элементам обоих массивов
If tN1(i1) = tN2(i2) Then

i1 = i1 + 1
tN2(i2) = 0
i2 = i2 + 1

'если текущий элемент первого массива больше текущего элемента
'второго массива, то производится переход к следующему элементу
'второго массива
ElseIf tN1(i1) > tN2(i2) Then

i2 = i2 + 1

'если текущий элемент второго массива больше текущего элемента
'первого массива, то производится переход к следующему элементу
'первого массива
Else

i1 = i1 + 1

End If

Loop

i1 = UBound(tN1)
k = 0

'проверяется число ненулевых элементов второго массива
For i2 = 1 To UBound(tN2)

If tN2(i2) > 0 Then k = k + 1

Next i2

'если во втором массиве есть ненулевые элементы, то
'переопределяется размер первого массива (увеличивается --
'ровно на количество ненулевых элементов второго массива)
'и ненулевые элементы второго массива добавляются в конец первого массива
'(во втором массиве занулены элементы/множители, которые уже были в первом массиве)
If k > 0 Then

ReDim Preserve tN1(i1 + k)

j = 1
i2 = 1

For i2 = 1 To UBound(tN2)

If tN2(i2) > 0 Then

tN1(i1 + j) = tN2(i2)
j = j + 1

End If

Next i2

End If

End Sub

'сортировка массивов
Sub sortArr(ByRef tN() As Integer)
Dim i As Integer, j As Integer, k As Integer

'если в массиве всего один элемент -- сортировка не производится
'(выход из процедуры сортировки)
If UBound(tN) = 1 Then Exit Sub

For i = 2 To UBound(tN)

For j = 1 To i - 1

If tN(j) > tN(i) Then

k = tN(i)
tN(i) = tN(j)
tN(j) = k

End If

Next j

Next i

End Sub

Релиб / Программирование / Visual Basic / решила интересную задачку, но её надо немного подредактировать / Latest Posts

RE: решила интересную задачку, но её надо немного подредактировать

решила интересную задачку, но её надо немного подредактировать