решила интересную задачку, но её надо немного подредактировать
Релиб
Форумы       Участники    Календарь    Кто он-лайн?
Добро пожаловать, гость ( Вход | Регистрация )
        



решила интересную задачку, но её надо немного... Expand / Collapse
Автор
Сообщение
02.04.2007 10:46
новичок

новичокновичокновичокновичокновичокновичокновичокновичок

участник
Last Login: 26.05.2007 20:49
Сообщ.: 6, Visits: 6
Задачка была такая:

Найти наименьшее общее кратное 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

Сообщ. #912127
02.04.2007 12:35
Supreme Being

Supreme Being

модератор
Last Login: 04.05.2008 13:32
Сообщ.: 7 240, Visits: 65 445
lapulechka, большая просьба, в будущем указывать тему сообщения, а не оставлять ее пустой.
Сообщ. #912137
« пред. тема | след. тема »


Эту тему читают Expand / Collapse
Посетители: 0 (0 гостей, 0 участников, 0 скрыт.участников)
Сейчас нет участников, просматривающих тему.
Модераторы: Alexey, boombastik, bazile, pl, Comanche, Alexey Spirin

Время GMT +3:00, Сейчас 5:11