Sub Макрос1()
'
' Макрос1
'
' Сочетание клавиш: Ctrl+q
'
Const N = 5 'размер исходной матрицы
Dim a(N, N) As Variant 'хранится исходная матрица
Dim q(N, N) As Integer
Dim b(N) As Double 'результат
Dim rez As String
Dim w As String
Dim o As Variant
Dim r As Byte
Dim d As String 'результат
Dim col As Integer
col = 0
'заполняем матрицу элементами
For i = 1 To N
For j = 1 To N
a(i, j) = InputBox(" a(" & i & "," & j & ")", , 0)
rez = rez & a(i, j) + Chr(9)
q(i, j) = a(i, j)
Next j
rez = rez + Chr(13)
Next i
'считаем определитель
o = a(1, 1) * (a(2, 2) * a(3, 3) * a(4, 4) - a(2, 2) * a(3, 4) * a(4, 3) - a(2, 3) * a(3, 2) * a(4, 4) + a(2, 3) * a(3, 4) * a(4, 2) + a(2, 4) * a(3, 2) * a(4, 3) - a(1, 3) * a(2, 2) * a(3, 1)) - a(1, 2) * (a(2, 1) * a(3, 3) * a(4, 4) - a(2, 1) * a(3, 4) * a(4, 3) - a(2, 3) * a(3, 1) * a(4, 4) + a(2, 3) * a(3, 4) * a(4, 1) + a(2, 4) * a(3, 1) * a(4, 3) - a(2, 4) * a(3, 3) * a(4, 1)) + a(1, 3) * (a(2, 1) * a(3, 2) * a(4, 4) - a(2, 1) * a(3, 4) * a(4, 2) - a(4, 4) * a(2, 2) * a(3, 1) + a(2, 4) * a(3, 1) * a(4, 2) + a(4, 1) * a(2, 2) * a(4, 4) - a(2, 4) * a(3, 2) * a(4, 1)) - a(1, 4) * (a(2, 1) * a(3, 2) * a(4, 3) - a(2, 1) * a(4, 2) * a(3, 3) - a(4, 3) * a(2, 2) * a(3, 1) + a(2, 3) * a(3, 1) * a(4, 2) + a(4, 1) * a(2, 2) * a(3, 3) - a(2, 3) * a(3, 2) * a(4, 1))
w = o
'строим результирующую матрицу
For i = 0 To 5
For j = 0 To 5
If (q(i, j) < r) Then
r = q(i, j)
End If
Next j
Next i
For i = 0 To 5
For j = 0 To 5
q(i, j) = Int(q(i, j) / r)
Next j
Next i
For i = 1 To N
d = d & b(i) & Chr(9)
Next i
rez = "Введенная матрица " + Chr(13) + rez + Chr(13) + "Результирующая матрица: " + Chr(13) + d + Chr(13) + "Определитель матрицы = " + w
MsgBox Prompt:=rez, Buttons:=vbOKCancel, Title:="Результат"
Set wrd = CreateObject("Word.Application")
wrd.Visible = True
Set Doc = wrd.Documents.Add
Doc.Range.Text = rez
Doc.SaveAs "D:\Лаб3.doc"
End Sub