Legio
Advanced Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
AndronH
раскладываешь на множители и сравниваешь (выкидываешь лишние) -- вот и весь алгоритм 
lapulechka
Код:
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
|
мне таки лень было писать разумные комментарии, так что какие есть  |
ray 
Мне вообще это назавтра надо, я сёдня все книги перерыла, кое-что получилось, но кое-что и глючило. А теперь с твоей помощью я завтра всё успешно сдам!