Вычислить среднее геометрическое по данным выделенной таблицы

@DJONII · Регистрация: 28.12.2011

Author24 — интернет-сервис помощи студентам

Доброе время суток! Помогите пожалуйста кто чем сможет! сделать макросы в excel :

1) Вычислить среднее геометрическое по данным выделенной таблицы.

я тут набросал чтоб он брал данные из выделенной таблицы а как дальше быть незнаю, как сделать чтобы вычеслял среднее геометрическое и выводил его в ячеку?

Visual Basic

Dim Mass() As Variant
Dim i As Integer
Dim j As Integer
Dim X As Integer
Dim Y As Integer
Dim H As Integer
Dim W As Integer
X = Selection.Row
Y = Selection.Column
H = Selection.Rows.Count
W = Selection.Columns.Count
ReDim Mass(H, W)
For i = 1 To H
    For j = 1 To W
        Mass(i, j) = Cells(X + i, Y + j - 1)  
    Next j
Next i
...

2) Поле шахматной доски определяется парой натуральных чисел, первое из которых задает номер вертикали, а второе – номер горизонтали. Даны натуральные числа k, l, m, n. Требуется выяснить, являются ли поля (k, l) (m, n) полями одного цвета.

@ikki · 12.06.2012, 13:07

код не совсем правильный.

Visual Basic

1	option base 1

я не вижу. значит - по умолчанию каждая размерность массива индексируется с 0.
циклы вылетят с ошибкой "out of range"
да и

Visual Basic

1	Cells(X + i, Y + j - 1)

- тоже неправильно. по строке надо тоже отнимать единичку.

раз уж у вас массив Variant, то проще писать так:

Visual Basic

1 2	dim mass() mass=selection.value

среднее геометрическое - это корень n-й степени из произведения. в чём проблема?

по второй задаче - попробуйте сложить номер горизонтали и номер вертикали для разных клеточек доски и увидеть закономерность.

@DJONII · 12.06.2012, 13:49 **[ТС]**

это да, забыл выделить)

Visual Basic

1	option base 1

проморгал)

Visual Basic

1	Mass(i, j) = Cells(X + i - 1, Y + j - 1)

а что это значит? mass = Selection.Value

Visual Basic

Sub Макрос()
Dim mass()
mass = Selection.Value
Dim i As Integer
Dim j As Integer

тут дальше нужно вычеслить среднее геометрическое и как то вывести результат, я вообще непредставляю как это можно сделать, помоги пжл, вроде как ещё одну переменную придётся создавать?

Visual Basic

Option Base 1
Sub Макрос()
Dim mass()
mass = Selection.Value
Dim i As Integer
Dim j As Integer
Dim X As Integer
Dim Y As Integer
Dim H As Integer
Dim W As Integer
X = Selection.Row
Y = Selection.Column
H = Selection.Rows.Count
W = Selection.Columns.Count
ReDim mass(H, W)
For i = 1 To H
    For j = 1 To W
        mass(i, j) = Cells(X + i - 1, Y + j - 1)       
    Next j
Next i
...

@ikki · 12.06.2012, 14:05

Visual Basic

1	mass = Selection.Value

это как раз заполнение двумерного массива типа Variant значениями из выделенного диапазона.
правда, если выделенный диапазон будет несмежным, то тут возникнет ошибка.
но это - крайний случай.
как я понял, мы предполагаем, что юзер находится в здравом уме и выделяет на листе прямоугольный диапазон ячеек с числами?

для классического алгоритма переменная, конечно, нужна:

Visual Basic

dim p#
p=1
for i=1 to ubound(mass,1)
  for j=1 to ubound(mass,2)
    p = p * mass(i,j)
next j, i
msgbox p^(1/(ubound(mass,1)*ubound(mass,1)))
selection.cells(1).offset(0,ubound(mass,2)+1).value= _
p^(1/(ubound(mass,1)*ubound(mass,1)))

@DJONII · 12.06.2012, 14:33 **[ТС]**

[Оверквотинг. Не цитируйте посты ЦЕЛИКОМ!]

полный код так получаеться?:

Visual Basic

option Base 1
Sub Макрос()
 
Dim mass()
mass = Selection.Value
Dim p#
p = 1
For i = 1 To UBound(mass, 1)
  For j = 1 To UBound(mass, 2)
    p = p * mass(i, j)
Next j, i
MsgBox p ^ (1 / (UBound(mass, 1) * UBound(mass, 1)))
Selection.Cells(1).Offset(0, UBound(mass, 2) + 1).Value = _
p ^ (1 / (UBound(mass, 1) * UBound(mass, 1)))
End Sub

если да, то он что-то не то считает я выделил(к примеру):
6 5 2
6 7 2
он выдаёт 8,425731
а если сделаю проверку с помощью СРГЕОМ(...)
то он покажет 4,140681
странно... может я что-то не так вставил?

@ikki · 12.06.2012, 14:55

прошу меня извинить, у меня в коде ошибка (из-за копипаста)
должно быть так:

Visual Basic

13	MsgBox p ^ (1 / (UBound(mass, 1) * UBound(mass, 2)))

ну и 15-я строка - аналогично.
все остальное - да, правильно.

@DJONII · 12.06.2012, 15:15 **[ТС]**

СПАСИБО БОЛЬШУЩЕЕ!!! ВСЁ РАБОТАЕТ)!!!

2)Поле шахматной доски определяется парой натуральных чисел, первое из которых задает номер вертикали, а второе – номер горизонтали. Даны натуральные числа k, l, m, n. Требуется выяснить, являются ли поля (k, l) (m, n) полями одного цвета.

на счёт второй как понял, можно же сделать так что бы k m l n переменные он брал произвольно не выделяя ячейки или лучше выделять? не могу понять как можно тогда вбить их в код чтобы он понял что например ячейка A1 это k, B1 это m, С1 это l, D1 это n, условие же будет такое?
если удовлетворяет то да они одного цвета, если нет то разного
((k And 1) = (m And 1)) AndAlso ((l And 1) = (n And 1))

@ikki · 12.06.2012, 15:22

а зачем вам вообще ячейки для второй задачи?
у вас даны координаты двух клеток - числами. можно ввести через InputBox.
высчитывайте в макросе цвет одной клетки и цвет другой.
сравнивайте.
выдавайте результат-сообщение.

@DJONII · 12.06.2012, 15:30 **[ТС]**

а как вычислить цвет одной и другой клетки?

@ikki · 12.06.2012, 15:37

уже писал:

Сообщение от ikki

по второй задаче - попробуйте сложить номер горизонтали и номер вертикали для разных клеточек доски и увидеть закономерность.

DJONII, Вы, возможно, заметили - у меня свои "тараканы" - я человеку, отказывающемуся думать, помогать не люблю.
но форум большой, просто праздники, наверное, поэтому затишье.
если просто хотите готовый код - подождите других форумчан.

@DJONII · 12.06.2012, 16:13 **[ТС]**

написал только где то ошибка, немогу понять где...
как мне кажется где-то в условии...

Visual Basic

Sub Макрос()
Dim k As Integer, l As Integer, m As Integer, n As Integer
k = InputBox("Введите k, координату первой ячейки по горизонтали", "Окно ввода")
l = InputBox("Введите l, координату первой ячейки по вертикали", "Окно ввода")
m = InputBox("Введите m, координату второй ячейки по горизонтали", "Окно ввода")
n = InputBox("Введите n, координату второй ячейки по вертикали", "Окно ввода")
If ((k + n) = (m + l)) Then
MsgBox ("Цвета ячеек одинаковы")
Else
MsgBox ("Цвета ячеек разные")
End If
End Sub

@~~Апострофф~~ · 13.06.2012, 07:36

Visual Basic

1	msgbox iif (((k+l)and 1)=((m+n)and 1), "Поля одного цвета","Поля разных цветов")

@DJONII · 13.06.2012, 10:43 **[ТС]**

Спасибо за помощь!!!

@DJONII 3 / 3 / 1 Регистрация: 28.12.2011 Сообщений: 25
	12.06.2012, 15:15 [ТС]	7
	СПАСИБО БОЛЬШУЩЕЕ!!! ВСЁ РАБОТАЕТ)!!! 2)Поле шахматной доски определяется парой натуральных чисел, первое из которых задает номер вертикали, а второе – номер горизонтали. Даны натуральные числа k, l, m, n. Требуется выяснить, являются ли поля (k, l) (m, n) полями одного цвета. на счёт второй как понял, можно же сделать так что бы k m l n переменные он брал произвольно не выделяя ячейки или лучше выделять? не могу понять как можно тогда вбить их в код чтобы он понял что например ячейка A1 это k, B1 это m, С1 это l, D1 это n, условие же будет такое? если удовлетворяет то да они одного цвета, если нет то разного ((k And 1) = (m And 1)) AndAlso ((l And 1) = (n And 1)) 0

@ikki призрак 3262 / 890 / 119 Регистрация: 11.05.2012 Сообщений: 1,702 Записей в блоге: 2
	12.06.2012, 15:22	8
	а зачем вам вообще ячейки для второй задачи? у вас даны координаты двух клеток - числами. можно ввести через InputBox. высчитывайте в макросе цвет одной клетки и цвет другой. сравнивайте. выдавайте результат-сообщение. 1

@DJONII 3 / 3 / 1 Регистрация: 28.12.2011 Сообщений: 25
	12.06.2012, 15:30 [ТС]	9
	а как вычислить цвет одной и другой клетки? 0

@ikki призрак 3262 / 890 / 119 Регистрация: 11.05.2012 Сообщений: 1,702 Записей в блоге: 2
	12.06.2012, 15:37	10
	уже писал: Сообщение от ikki по второй задаче - попробуйте сложить номер горизонтали и номер вертикали для разных клеточек доски и увидеть закономерность. DJONII, Вы, возможно, заметили - у меня свои "тараканы" - я человеку, отказывающемуся думать, помогать не люблю. но форум большой, просто праздники, наверное, поэтому затишье. если просто хотите готовый код - подождите других форумчан. 1

@DJONII 3 / 3 / 1 Регистрация: 28.12.2011 Сообщений: 25
	13.06.2012, 10:43 [ТС]	13
	Спасибо за помощь!!! 0