Главная Вход в систему Регистрация
Задать вопрос Консультации Пользователи Форум
О системе Помощь
Задать вопрос экспертам
Консультация № 180671
10.11.2010, 15:53
49.06 руб.
0 10 2
Компьютеры Программирование
Здравствуйте,
помогите с решением задачи.

Макрос вычисления среднего геометрического по выделенным данным на листе EXCEL.

спасибо.

Обсуждение

давно
Megaloman
Модератор
137394
1850
10.11.2010, 18:00
общий
это ответ
Здравствуйте, Матвеев Денис Александрович!
Вот макрос, решающий задачу. Вы должны выделить диапазон ячеек с численными данными и запустить макрос на выполнение. ПолУчите на экране ответ. Если в выбранном диапазоне - не все данные численные - возникнет ошибочная ситуация.
Код:
Sub sg()
'
Dim Mas As Variant      ' Массив, куда прочтем значения ячеек выделенного диапазона
Mas = Selection         ' Читаем значения выделенных ячеек в массив
'
N1 = UBound(Mas, 1)     ' Определяем размерность массива - число строк
N2 = UBound(Mas, 2)     ' Определяем размерность массива - число столбцов
'
P = 1                   ' Начальное значение произведения =1
For i = 1 To N1
    For j = 1 To N2
        P = P * Mas(i, j)   ' Ищем произведение всех элементов массива
    Next
Next
'
P = P ^ (1 / N1 / N2)       ' Извлекаем корень степени 1/N1/N2 (получаем среднее геометрическое)
'
MsgBox P, vbOKOnly, "Среднее геометрическое чисел выделенного диапазона"
'
End Sub
5
Большое спасибо, все работает.
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Неизвестный
10.11.2010, 18:37
общий
это ответ
Выделенные ячейки не должны быть пустыми.

Приложение:
Sub sr()

Dim r As Range

Set r = Selection.Cells ' выделенне ячейки
n = r.Count ' кол-во ячеек
p = 1 ' p-произведение чисел в ячейках
For Each r In Selection.Cells
p = p * Val(r)
Next
g = p ^ (1 / n) ' среднее геометрическое

MsgBox g
End Sub
давно
lamed
Академик
320937
2216
10.11.2010, 20:37
общий
Работает, однако
Неизвестный
10.11.2010, 22:18
общий
Адресаты:
Без сомнений! =)
Спасибо.
Добавить проверку на 0, null, empty и идельный код)
давно
Megaloman
Модератор
137394
1850
11.11.2010, 10:10
общий
Адресаты:
-красиво! Ни за что бы не сообразил, что так кому-то нужно. Но, если диапазон сплошной, работа с массивом многократно эффективнее. Попробуйте на листе таблицы вставить 1 (чтобы не связываться с переполнением разрядности), например, с ячейки A1 по IV2000, выделите этот диапазон, и обработайтн его сначала одним макросом, потом другим. Время выполнения радикально отличается.
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Неизвестный
11.11.2010, 11:40
общий
Адресаты:
Да действительно, работа именно с ячейками в excel занимает больше времени. Диапазон A1-D50000 с вашим кодом заняла меньше секунды(0:00:00), с моим вариантом больше 3 секунд(0:00:03). Время забивания этого диапазона макросом около 47 секунд. Выбор пусть делают под конкретную задачу.
PS. Где же "золотая середина"?
давно
lamed
Академик
320937
2216
11.11.2010, 12:59
общий
Адресаты:
Добрый день, господа! Вспомним, что говорит вопрошающий
..по выделенным данным..
Как мы видим, нет явного указания о непрерывной матрице. В этом случае возможен вариант выделения, который я привел.
Выделяем ненулевые ячейки "ручками". При запуске первого ответа получаем ошибку. Программа второго ответа отрабатывает правильно.
давно
Megaloman
Модератор
137394
1850
11.11.2010, 13:06
общий
Выбор пусть делают под конкретную задачу.
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
давно
Megaloman
Модератор
137394
1850
11.11.2010, 16:11
общий
Из любопытства сравнил 2 скрипта. При занесении значений в ячейки на диапазоне ("A1:IV2000") первый у меня делался 3", второй 47". По чтению разница гораздо меньше.
Код:
Sub sgg()
t1 = Time()

N1 = Selection.Rows.Count
N2 = Selection.Columns.Count
ReDim Mas(1 To N1, 1 To N2) As Variant

For i = 1 To N1
    For j = 1 To N2
        Mas(i, j) = i * 1000 + j
    Next
Next
Selection = Mas
t2 = Time()
MsgBox CStr(t1) + vbCrLf + CStr(t2)

End Sub

Код:
Sub srr()
t1 = Time()
Dim r As Range
Set r = Selection.Cells

n = r.Count
i = 0
For Each r In Selection.Cells
    i = i + 1
    r = i
Next
t2 = Time()
MsgBox CStr(t1) + vbCrLf + CStr(t2)
End Sub
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Неизвестный
14.11.2010, 04:59
общий
Адресаты:
Неудивительно, в первом случае большая часть операций выполняется в памяти и один раз ссылается на объект Selection.
Во втором же примере, ссылается 8000 раз на объект Selection.

Но это того стоит.
Форма ответа