Перевести код программы с VB на VBA

Узнай цену своей работы

Формулировка задачи:

Кто нибудь может помочь перевести код программы с VB на VBA?

Решение задачи: «Перевести код программы с VB на VBA»

textual
Листинг программы
Sub Kramer(A() As Double, Y() As Double, R() As Double, flgRes As Boolean)
Dim T() As Double
    n% = UBound(Y, 1)
    D_main = Det(A)
    If Abs(D_main) <= 0.0000000001 Then
       flgRes = False
       Exit Sub
    End If
    ReDim T(1 To n%, 1 To n%) As Double
    For ii% = 1 To n%
        For i% = 1 To n%
            For j% = 1 To n%
                T(i%, j%) = A(i%, j%)
            Next j%
        Next i%
        For j% = 1 To n%
            T(j%, ii%) = Y(j%)
        Next j%
        R(ii%) = Det(T) / D_main
    Next ii%
    flgRes = True
End Sub
 
Function Det(A() As Double) As Double
     n% = UBound(A, 1)
     If n% = 2 Then
        Det = A(1, 1) * A(2, 2) - A(1, 2) * A(2, 1)
     Else
        S# = 1
        For j% = 1 To n%
            Det = Det + A(1, j%) * Det(Minor(A(), 1, j%)) * S#
            S# = -S#
        Next j%
     End If
End Function
 
Function Minor(A() As Double, m As Integer, k As Integer) As Double()
Dim B() As Double
    nn% = UBound(A, 1)
    ReDim B(1 To nn% - 1, 1 To nn% - 1) As Double
    ii% = 1
    jj% = 1
    For i% = 1 To nn%
        For j% = 1 To nn%
            If i% <> m And j% <> k Then
               B(ii%, jj%) = A(i%, j%)
               jj% = jj% + 1
               If jj% > nn% - 1 Then
                  ii% = ii% + 1
                  jj% = 1
               End If
            End If
        Next j%
     Next i%
     Minor = B
End Function
 
Sub Test()
 
Dim A(1 To 4, 1 To 4) As Double
Dim Y(1 To 4)         As Double
Dim R(1 To 4)         As Double
Dim flg               As Boolean
 
    A(1, 1) = 1
    A(1, 2) = 1
    A(1, 3) = 1
    A(1, 4) = 1
    
    A(2, 1) = 2
    A(2, 2) = 1
    A(2, 3) = 2
    A(2, 4) = 1
    
    A(3, 1) = 0
    A(3, 2) = 1
    A(3, 3) = 3
    A(3, 4) = -2
    
    A(4, 1) = 7
    A(4, 2) = 1
    A(4, 3) = -1
    A(4, 4) = 5
    
    Y(1) = 0
    Y(2) = 2
    Y(3) = 4
    Y(4) = 0
 
    Kramer A, Y, R, flg
    
    If flg Then
       For i% = 1 To 4
           Debug.Print R(i%)
       Next i%
    Else
       Debug.Print "Решений нет!"
    End If
End Sub

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

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