'
Sub SolutEqu()
UfSelect.Ouvrir "SolutEquGo", "Résolution d'un système d'équations linéaires par formule Excel", _
"Rect:La matrice carrée m*m des M telle qu'à chacune des" & vbLf & "m lignes L : " _
& ChrW$(8721) & " { pour C=1 à m: M(L,C) × X(C) } = Y(L)", _
"Rect:La table des valeurs Y(L)" & vbLf _
& "(plusieurs colonnes possibles)", _
"Rect:La plage résultante à garnir des X(C), la solution du" & vbLf _
& "système, orientée en lignes ou en colonnes à votre goût !"
End Sub
Sub SolutEquGo(TRg() As Range)
Dim NbL As Long, NbC As Long, Nbid As Long, OrIntui As Boolean, Déterm As Double, ZM As String, ZY As String, Z As String
With TRg(0): NbL = .Rows.Count: NbC = .Columns.Count: End With
If NbL <> NbC Then
Nbid = Int(Sqr(NbL * NbC) + 0.5)
UfSelect.ÉtapePlage 0, TRg(0)(1, 1).Resize(Nbid, Nbid), _
"Votre matrice n'était pas carrée" & vbLf & "(" & NbL & " lignes de " & NbC & " colonnes)"
Exit Sub: End If
NbC = TRg(1).Columns.Count
If TRg(1).Rows.Count <> NbL Then
UfSelect.ÉtapePlage 1, TRg(1)(1, 1).Resize(NbL, NbC), "Votre table des valeurs Y comportait" _
& vbLf & TRg(1).Rows.Count & " lignes au lieu de " & NbL
Exit Sub: End If
With TRg(2)
If NbL <> NbC Then
OrIntui = NbL > NbC Xor .Rows.Count > .Columns.Count
ElseIf TRg(2).Column = TRg(0).Column Then
OrIntui = MsgBox("Ayant demandé les solutions aux mêmes colonnes que la matrice," _
& vbLf & "désirez vous bien une ligne de coefficients X pour chaque somme Y ?" _
& vbLf & "(sinon: le résultat sera orienté comme d'usage en algèbre matriciel)", _
vbYesNo + vbQuestion, "Résolution système d'équations par formule Excel") = vbYes
Else
OrIntui = MsgBox("Hmm! c'est vraiment partout carré cette affaire là !" _
& vbLf & "Désirez vous l'orientation appliquée en mathématique matricielle ?" _
& vbLf & "(sinon orientation intuitive: une ligne de X pour chaque colonne Y)", _
vbYesNo + vbQuestion, "Résolution système d'équations par formule Excel") = vbNo
End If
If OrIntui Then Nbid = NbL: NbL = NbC: NbC = Nbid
If .Rows.Count <> NbL Or .Columns.Count <> NbC Then
UfSelect.ÉtapePlage 2, .Resize(NbL, NbC), "Votre plage résultante n'était pas" _
& vbLf & " dimensionnée convenablement"
Exit Sub
End If
End With
On Error Resume Next
Déterm = WorksheetFunction.MDeterm(TRg(0))
If Déterm = 0 Then Z = "pas de solution" Else Z = "solution en bonne voie"
MsgBarreÉtat "Matrice " & DescrZones(TRg(0)) & ": Déterminant = " & Déterm & " (" & Z & ")."
ZM = TRg(0).Name.Name
If Err <> 0 Then ZM = TRg(0).Address(True, True, xlR1C1, TRg(0).Worksheet.Name <> TRg(2).Worksheet.Name)
Err.Clear
ZY = TRg(1).Name.Name
If Err <> 0 Then ZY = TRg(1).Address(True, True, xlR1C1, TRg(1).Worksheet.Name <> TRg(2).Worksheet.Name)
Err.Clear
Z = "MMULT(MINVERSE(" & ZM & ")," & ZY & ")"
If OrIntui Then Z = "=TRANSPOSE(" & Z & ")" Else Z = "=" & Z
TRg(2).FormulaArray = Z
If Err <> 0 Then
MsgBox "Installation de :" & vbLf & """" & Z & """" & vbLf & "==> Err." & Err.Number & ": " & Err.Description, _
vbCritical, "Résolution système d'équation"
UfSelect.Réactiver
Else
UfSelect.Fermer
End If
End Sub
