Option Explicit
Const n As Integer = 2
Dim A(1 To n, 1 To n) As Single
Dim A1(1 To n, 1 To n) As Single
Dim c(1 To n) As Single
Dim E(1 To n, 1 To n) As Single
Dim B(1 To n, 1 To n) As Single
Dim B1(1 To n, 1 To n) As Single
Dim x(1 To n) As Single
Dim X1(1 To n) As Single
Dim Ax(1 To n) As Single
Dim AX1(1 To n) As Single
Dim BC(1 To n, 1 To n) As Single
Dim BC1(1 To n, 1 To n) As Single
Dim r As String
'Ввод матрицы A,A1 и вектора C
Sub ввод_массива(ByVal n As Integer, k As Integer, ix As Integer, iy As Integer, ByRef d() As Single)
Static i As Integer, j As Integer
Select Case k
Case 1
For i = 1 To n
Cells(i + ix, iy) = InputBox("вести " & i & " элемент вектора")
d(i) = Cells(i + ix, iy)
Next i
Case 2
For i = 1 To n
For j = 1 To n
Cells(i + ix, j + iy) = InputBox("вести элемент матрицы (" & i & "," & j & ")")
d(i, j) = Cells(i + ix, j + iy)
Next j
Next i
Range("B1") = " Матрица "
Range("C1") = " A "
Range("E1") = "Вектор С"
Range("B5") = " Матрица "
Range("C5") = " A1 "
End Select
End Sub
'Инициализация единичной матрицы I
Private Sub единичная_матрица(ByVal n As Integer, ix As Integer, iy As Integer, ByRef d() As Single)
Static i As Integer, j As Integer
MsgBox "инициализировать единичную матрицу размера " & n
For i = 1 To n
For j = 1 To n
If i = j Then
Cells(i + ix, j + iy) = 1
ElseIf i <> j Then
Cells(i + ix, j + iy) = 0
End If
d(i, j) = Cells(i + ix, j + iy)
Next j
Next i
Range("G1") = " Матрица "
Range("H1") = " E "
End Sub
'Вычитание матриц I-A и I-A1
Sub вычитание_матриц(ByVal n As Integer, G() As Single, H() As Single, ix As Integer, iy As Integer, ByRef d() As Single)
Static i As Integer, j As Integer
MsgBox "Вычитание матриц размера " & n
For i = 1 To n
For j = 1 To n
Cells(i + ix, j + iy) = G(i, j) - H(i, j)
d(i, j) = Cells(i + ix, j + iy)
Next j
Next i
Range("J1") = " Матрица "
Range("K1") = " B "
Range("J5") = " Матрица "
Range("K5") = " B1 "
End Sub
'Умножение матрицы А на вектор Х
Sub умножение_матриц(ByVal n As Integer, G() As Single, H() As Single, ix As Integer, iy As Integer, ByRef d() As Single)
Static i As Integer, j As Integer
MsgBox "Умножение матрицы на вектор"
For i = 1 To n
d(i) = 0
For j = 1 To n
d(i) = d(i) + G(i, j) * H(j)
Next j
Cells(i + ix, iy) = d(i)
Next i
Range("M1") = "Вектор X"
Range("M5") = "Вектор X1"
Range("O1") = "Вектор AX"
Range("O5") = "Вектор AX1"
End Sub
'обращение матрицы (I-A)=B, В нашем случае BC и BC1
Sub обращение_матриц(ByVal n As Byte, x() As Single, ByRef y() As Single)
Static i As Byte, j As Byte, k As Byte
Dim AP(1 To 2, 1 To 2) As Single
For k = 1 To 2
For j = 1 To 2
If (j <> k) Then
AP(k, j) = -x(k, j) / x(k, k)
End If
Next j
For i = 1 To n
If (i <> k) Then AP(i, k) = A(i, k) / x(k, k)
Next i
For i = 1 To n
For j = 1 To n
If (i <> k) And (j <> k) Then
AP(i, j) = x(i, j) - x(i, k) + x(k, j) / x(k, k)
End If
Next j
Next i
AP(k, k) = 1 / A(k, k)
Next k
For i = 1 To n
For j = 1 To n
y(i, j) = AP(i, j)
Next j
Next i
For i = 1 To 2
For j = 1 To 2
Cells(i + 9, j + 11) = BC(i, j)
Next j
Next i
For i = 1 To 2
For j = 1 To 2
Cells(i + 9, j + 14) = BC1(i, j)
Next j
Next i
Range("M9") = "BC"
Range("P9") = "BC1"
End Sub
'Сравниваем АХ и С
Sub сравнение_векторов(n As Byte, d() As Single, c() As Single, r)
Static i As Byte
i = 1
Do While i < 2
If d(i) > c(i) Then
r = "Экономика высокоэффективна"
ElseIf d(i) < c(i) Then
r = "экономика невысокоэффективна"
End If
Exit Do
i = i + 1
Loop
Range("B10") = "для A -"
Range("B11") = "для A1 -"
Range("C10") = r
Range("C11") = r
End Sub
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.