Составить вектор из сумм элементов матрицы, больших среднего геометрического, по строкам - VBA
Формулировка задачи:
Написал программу, но не выводит вектор. Проверьте пожалуйста я правильно записал формулу ср. геометрического. Спасибо заранее!
Ввести массив А(N,M). Составить вектор из сумм элементов, больших среднего геометрического, по строкам.
Решение задачи: «Составить вектор из сумм элементов матрицы, больших среднего геометрического, по строкам»
textual
Листинг программы
'Option Explicit Sub VectoR() Const shn = "Составить вектор" '------------ ! n = 7 m = 12 '------------ ! tx = _ "Сейчас будет созданн новый лист с расчетами" & vbCrLf & _ "Введите значения [n * m]" & vbCrLf & _ "примерно так-же как внизу:" While b = False x = InputBox(tx, , n & "*" & m) If Len(x) Then x = Split(x, "*") b = UBound(x) = 1 If b Then If IsNumeric(Trim(x(0))) Then n = Val(x(0)) Else b = 0 If IsNumeric(Trim(x(1))) Then m = Val(x(1)) Else b = 0 End If Else: Exit Sub End If Wend Application.DisplayAlerts = False If SheetExists(shn) Then Worksheets(shn).Delete 'Создание таблицы With Worksheets.Add: .Name = shn With .Cells(1, 1) .AddComment tx = _ "Условие:" & vbLf & _ "Составить вектор из сумм элементов матрицы," & vbLf & _ "больших среднего геометрического, по строкам" .Comment.Text Text:=tx .Comment.Shape.TextFrame.AutoSize = True .Value = "Matrix !" End With With .Range(.Cells(1, 1), .Cells(1, n)) .Merge 'Объеденение верхней полоски .HorizontalAlignment = xlCenter For xl = 7 To 10: .Borders(xl).LineStyle = 1: Next 'Границы .Interior.ColorIndex = 33 'Цвет End With .Cells(1, n + 2) = "Сумма по строкам (формулы)" With .Range(.Cells(2, n + 2), .Cells(m + 1, n + 2)) For Each el In .Rows 'Отдельно по каждой For xl = 7 To 10: el.Borders(xl).LineStyle = 1: Next 'Границы Next .Interior.ColorIndex = 35 End With 'Заполнение числами похожими на геом.-прогрессию For j = 2 To m + 1: For i = 1 To n: .Cells(j, i) = i * j: Next i, j '===========Вычисление vec = Split(Space(m - 1)) For j = 2 To m + 1 geo = WorksheetFunction.GeoMean(.Range(.Cells(j, 1), .Cells(j, n))) isum = 0 For i = 1 To n If .Cells(j, i) > geo Then Set r = .Range(.Cells(j, i), .Cells(j, n)) For xl = 7 To 10: r.Borders(xl).LineStyle = xlDash: Next 'Границы With .Cells(j, n + 2) .Value = "=SUM(" & r.Address & ")" vec(j - 2) = WorksheetFunction.Sum(r) .AddComment .Comment.Text Text:="Средне-геометрическое:" & vbLf & geo .Comment.Shape.TextFrame.AutoSize = True End With Exit For End If Next i, j tx = _ "Готово !" & vbCrLf & _ "Вектор: [" & Join(vec, ", ") & "]" & vbCrLf & _ "Удалить этот лист ?" If MsgBox(tx, 68) = vbNo Then Exit Sub .Delete End With Application.DisplayAlerts = True End Sub Function SheetExists(ByVal Name$) As Boolean On Error Resume Next txName = "": txName = Worksheets(Name).Name SheetExists = Len(txName) End Function
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д