Нахождение максимального значения в матрице
Private Sub Command1_Click()
Dim m(), i As Integer, j As Integer, N As Integer
Dim max_m, i_max, j_max
N = 9
ReDim m(N, N)
Me.AutoRedraw = True ' можна в свойствах
Me.Cls
Randomize
For i = 1 To N
For j = 1 To N
m(i, j) = Int(Rnd * 100) ' èëè
'm(i, j) = Val(InputBox("вводим m(" & i & "," & j & ")", , Int(Rnd * 100)))
Me.Print m(i, j) & " ";
Next j
Me.Print 'vbNewLine
Next i
Me.Print vbNewLine & "--------------------------" & vbNewLine
max_m = m(1, 1)
For i = 1 To Int(N / 2) + 1 ' For i = 1 To N \ 2 + 1
Me.Print Tab(4 * (i - 1));
For j = i To N - i + 1
Me.Print m(i, j) & " ";
If max_m < m(i, j) Then
max_m = m(i, j)
i_max = i: j_max = j
End If
Next j
Me.Print 'vbNewLine
Next i
Me.Print vbNewLine & "--------------------------" & vbNewLine
Me.Print "max( i , j ) = m ( "; i_max; " , " & j_max; " ) = "; max_m
'MsgBox "max( i , j ) = m ( " & i_max & " , " & j_max & " ) = " & max_m
End Sub
Решение слау методом Крамера
Private Sub Command1_Click()
Dim a() As Double
Dim b() As Double
Dim x() As Double
Dim triangularMatrix() As Double
Dim N As Integer
N = InputBox("BBeduTe Pa3MepHocTb")
ReDim a(N, N)
ReDim b(N)
ReDim x(N)
Print "Na4al'na9 matrica"
For i = 1 To N
For j = 1 To N
a(i, j) = InputBox("BBoD 3na4enuu' koficeHTa a(" & i & ";" & j & ")")
Print a(i, j);
Next
b(i) = InputBox("BBoD 3na4enuu' svobodnogo 4lena " & i)
Print b(i)
Next
Print "Treygolnaya matrica"
triangularMatrix = getNewMatrix(N, a, b)
For i = 1 To N
For j = 1 To N
Print triangularMatrix(i, j);
Next
Print b(i)
Next
Dim retmatrix() As Double
retmatrix = triangularMatrix
For i = N To 1 Step -1
For j = 1 To N
If i = N Then
If j = N Then
b(i) = b(i) / retmatrix(i, j)
retmatrix(i, j) = 1
End If
Else
If j = i Then
For k = j + 1 To N
retmatrix(i, k) = retmatrix(i, k) * b(k)
b(i) = b(i) - retmatrix(i, k)
retmatrix(i, k) = 0
Next
b(i) = b(i) / retmatrix(i, j)
End If
End If
Next
Next
x = b
Print "Bektor peIIIenuu'"
For i = 1 To N
Print x(i)
Next
Dim checkArr() As Double
Print "Proverka"
checkArr = check(a, x)
For i = 1 To N
Print checkArr(i)
Next
End Sub
Function getNewMatrix(ByVal N As Integer, ByRef a() As Double, ByRef b() As Double) As Double()
Dim newMatrix() As Double
newMatrix() = a
Dim temp() As Double
ReDim temp(N, N)
Dim newVector() As Double
newVector = b
Dim tempb() As Double
ReDim tempb(N)
Index = 1
Dim u As Integer
For h = Index To N - 1
For i = h To N
Dim k
For j = 1 To N
If i = h Then
temp(i, j) = newMatrix(i, j)
Else
ij0 = newMatrix(i - h + u, h)
ij1 = newMatrix(i, h)
k = -1 * (ij1 / ij0)
If ij1 <> 0 Then
temp(i, j) = newMatrix(i, j) + k * newMatrix(i - h + u, j)
Else
temp(i, j) = 0
End If
End If
Next j
If i = h Then
tempb(i) = newVector(i)
Else
tempb(i) = newVector(i) + k * newVector(i - h + u)
End If
Next i
newMatrix = temp
newVector = tempb
u = u + 1
Next h
b = newVector
getNewMatrix = temp
End Function
Function check(ByRef a() As Double, ByRef x() As Double) As Double()
Dim ch() As Double
ReDim ch(UBound(a))
For i = 1 To UBound(a)
Dim summ As Double
summ = 0
For j = 1 To UBound(a)
summ = summ + a(i, j) * x(j)
Next
ch(i) = sum
Next
check = ch
End Function
