Составить вектор из сумм элементов матрицы, больших среднего геометрического, по строкам - 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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

12   голосов , оценка 4.25 из 5
Похожие ответы