VPF::[VBA] Вычислить общий делитель значений диапозона

Ki11eR0k

Дата 10.3.2007, 05:51 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 32
Регистрация: 2.11.2006

Репутация: нет
Всего: нет

Пользовательская функция с параметром диапозона.Вычислить общий делитель значений диапозона (общего делителя может и не быть). Нужен сам код и пример. smile

Genyaa

Дата 11.3.2007, 22:24 (ссылка)

(нет голосов)

Загрузка ...

Усердный

Профиль
Группа: Участник
Сообщений: 154
Регистрация: 25.9.2006
Где: Москва

Репутация: 5
Всего: 11

Код


Sub ввв()
'вызов функции делитель для выделенного диапазона в активном окне (может быть диапазон с несколькими областями)
    MsgBox делитель(ActiveWindow.RangeSelection)
End Sub

Public Function делитель(rr As Range)
'найдет максимальный целый делитель для значений диапазона в параметре
    Dim f As Long, m() As Long
    Dim i As Long, j As Long, k As Long
    Dim cc As Range, fla As Boolean
'приведем все значения диапазона к абсолютным значениям для поиска минимального по модулю
    ReDim m(0 To rr.Cells.Count)
    i = 1
    For Each cc In rr.Cells
        m(i) = Abs(cc)
        i = i + 1
    Next cc
'минимальный по модулю
    m(0) = m(1)
    j = WorksheetFunction.Min(m)
'если минимальный по модулю = 0 - решения нет.
    If j = 0 Then
        делитель = 0
        Exit Function
    End If
    m(0) = j 'поставим минимальный по модулю первым для проверки (чтобы не было много лишних проверок)
'начальный делитель минимального по модулю
    i = 1
    f = j
'начало цикла поиска делителя
    Do
'поднять флаг признака для выхода из цикла
        fla = True
'цикл проверки очередного значения - делитель ли?
        For k = 0 To UBound(m)
            If m(k) <> Fix(m(k) / f) * f Then
'если не разделилось нацело - не делитель
'увеличить делитель минимального по модулю
                i = i + 1
'опустить флаг признака
                fla = False
'выйти из цикла по k
                Exit For
            End If
        Next k
'очередное значение искомого делителя для проверки
        f = Fix(j / i)
'если к концу цикла k флаг поднят или очередное искомое равно 1, то это результат - выйти из цикла Do
        If fla Or f <= 1 Then Exit Do
    Loop
'присвоение найденного значения значению функции
    делитель = f
End Function

Это сообщение отредактировал(а) Genyaa - 11.3.2007, 22:43

--------------------

Всякое решение плодит новые проблемы.

Ki11eR0k

Дата 13.3.2007, 15:48 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 32
Регистрация: 2.11.2006

Репутация: нет
Всего: нет

Все работает,спасибо Genyaa.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »