| Код |
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
|
|
