Biến đổi ma trận thành ma trận chéo, tính định thức bằng VBA

[tieuthuvodanh1980]

Nhập 1 ma trận vào excel, chọn vùng chứa ma trận, chạy thủ tục Thêm Ma trận để thêm và đặt tên cho ma trận.
Gọi thủ tục Sub duavematrancheo(A) với A là tên ma trận dạng chuỗi
Kết quả từng bước sẽ đc trình bày trong excel

 

[tieuthuvodanh1980]

'bien doi ma tran thanh ma tran cheo
Public dau As Integer
Public R As Range
Sub ThemMatran()
Dim refer As String
refer = "=" & ActiveSheet.Name & "!" & Selection.Address
tenmang = InputBox("Nhap ten cua ma tran?", "Dat ten cho ma tran")
ActiveWorkbook.Names.add Name:=tenmang, RefersTo:=refer
frmMain.lstMatran.AddItem tenmang
End Sub
Function capMatran(ten, Optional rows) As String
Set R = ActiveWorkbook.Names(ten).RefersToRange
If Not IsMissing(rows) Then
If rows = 1 Then
capMatran = R.rows.Count
Else
capMatran = R.Columns.Count
End If
Else
capMatran = R.rows.Count & "x" & R.Columns.Count
End If
End Function
Sub hoandoihang(A, h1, h2)
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
Currow = R.rows.Count + R.Row: curcot = R.Column
dau = -dau
Cells(Currow + 1, curcot) = "Hoan doi dong " & h1 & " va dong " & h2 & ", dinh thuc co dau " & (dau)
R.Copy
Cells(Currow + 3, curcot).Select
ActiveSheet.Paste
Dim refer As String
refer = "=" & ActiveSheet.Name & "!" & Selection.Address
ActiveWorkbook.Names.add Name:=A, RefersTo:=refer
Set R = ActiveWorkbook.Names(A).RefersToRange
For j = 1 To m
tam = R.Cells(h1, j)
R.Cells(h1, j) = R.Cells(h2, j)
R.Cells(h2, j) = tam
Next

End Sub
Function timphantuso1(A) As String
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
For i = 1 To n
For j = 1 To m
If R.Cells(i, j) = 1 Then timphantuso1 = i & "x" & j: Exit Function
Next
Next
End Function
Sub duaso1vedau(A)
tim1 = timphantuso1(A)
If tim1 <> "1x1" And tim1 <> "" Then
n = Left(tim1, InStr(1, tim1, "x") - 1)
m = Mid(tim1, Len(n) + 2)
Debug.Print n & m
If n <> "1" Then hoandoihang A, 1, Val(n)
If m <> "1" Then hoandoicot A, 1, Val(m)

End If
End Sub


Sub hoandoicot(A, c1, c2)
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
Currow = R.rows.Count + R.Row: curcot = R.Column
dau = -dau
Cells(Currow + 1, curcot) = "Hoan doi cot " & c1 & " va cot " & c2 & ", dinh thuc co dau " & (dau)
R.Copy
Cells(Currow + 3, curcot).Select
ActiveSheet.Paste
Dim refer As String
refer = "=" & ActiveSheet.Name & "!" & Selection.Address
ActiveWorkbook.Names.add Name:=A, RefersTo:=refer
Set R = ActiveWorkbook.Names(A).RefersToRange
For i = 1 To n
tam = R.Cells(i, c1)
R.Cells(i, c1) = R.Cells(i, c2)
R.Cells(i, c2) = tam
Next
End Sub


Sub nhandong1vacong(A, k, d1, d2)
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
Currow = R.rows.Count + R.Row: curcot = R.Column

Cells(Currow + 1, curcot) = "Nhan dong " & d1 & " voi " & k & " va cong voi dong " & d2 & ", co dinh thuc:"
R.Copy
Cells(Currow + 3, curcot).Select
ActiveSheet.Paste
Dim refer As String
refer = "=" & ActiveSheet.Name & "!" & Selection.Address
ActiveWorkbook.Names.add Name:=A, RefersTo:=refer
Set R = ActiveWorkbook.Names(A).RefersToRange
For j = 1 To m
R.Cells(d2, j) = R.Cells(d1, j) * k + R.Cells(d2, j)
Next
End Sub
Sub tes()
duavematrancheo "A"
End Sub
Sub duavematrancheo(A)
Dim matrangoc As Range
dau = 1
Set matrangoc = ActiveWorkbook.Names(A).RefersToRange
duaso1vedau A
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
For j = 1 To m - 1
For i = j + 1 To n
If R.Cells(j, j) = 0 Then
t = timhangcoptkhac0(A, j, j)
If Val(t) > 0 Then
hoandoihang A, j, t
Else
Exit For
End If
End If
If R.Cells(i, j) * R.Cells(j, j) > 0 Then d = -1 Else d = 1
nhandong1vacong A, d * Abs(R.Cells(i, j)) / Abs(R.Cells(j, j)), j, i
Next
Next
Currow = R.rows.Count + R.Row: curcot = R.Column

kq = 1
For i = 1 To n
For j = 1 To m
If i = j Then kq = kq * R.Cells(i, j)
Next
Next
Cells(Currow + 1, curcot) = "Det(" & A & ")=" & kq * dau
On Error Resume Next
Cells(Currow + 2, curcot) = "Sai so: " & Round(Application.WorksheetFunction.MDeterm(matrangoc) - kq * dau, 5)
ActiveWorkbook.Names.add Name:=A, RefersTo:=matrangoc
End Sub
Function timhangcoptkhac0(A, h, c) As Byte
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
For i = h To n
If R.Cells(i, c) <> 0 Then timhangcoptkhac0 = i: Exit Function
Next
End Function

 

[ndu96081631]

Ổng này đang viết "tràng giang đại hải" gì thế không biết

 

[tieuthuvodanh1980]

Ổng này đang viết "tràng giang đại hải" gì thế không biết

Thực ra có thể viết ngắn hơn nhiều, nhưng tôi muốn đưa ra lời giải, với lại 1 số có thể gom lại để rút ngắn, nhưng chưa chỉnh. Nếu dùng đệ qui thì còn ngắn hơn nữa. ý tưởng lúc ban đầu là tôi định làm 1 cái add-in để tính tóan trên ma trận, định thức, nhưng đang còn vướng cái chỗ cây biểu thức nên chưa làm xong hết.

 

[hungpecc1]

Thực ra có thể viết ngắn hơn nhiều, nhưng tôi muốn đưa ra lời giải, với lại 1 số có thể gom lại để rút ngắn, nhưng chưa chỉnh. Nếu dùng đệ qui thì còn ngắn hơn nữa. ý tưởng lúc ban đầu là tôi định làm 1 cái add-in để tính tóan trên ma trận, định thức, nhưng đang còn vướng cái chỗ cây biểu thức nên chưa làm xong hết.

Đúng là " Giang tràng đại hải " chẳng hiểu gì hết !
Muốn giới thiệu thì bạn dẫn dắt mở đầu ,xem mặt mũi nó ra làm sao, rồi mới đến bộ phận chi tiết --> đàng này " bụp " một nhát thế thiên hạ chẳng hiểu gì cả !

 

[PhanTuHuong]

Thực ra có thể viết ngắn hơn nhiều, nhưng tôi muốn đưa ra lời giải, với lại 1 số có thể gom lại để rút ngắn, nhưng chưa chỉnh. Nếu dùng đệ qui thì còn ngắn hơn nữa. ý tưởng lúc ban đầu là tôi định làm 1 cái add-in để tính tóan trên ma trận, định thức, nhưng đang còn vướng cái chỗ cây biểu thức nên chưa làm xong hết.

Tốt nhất là bạn gửi file mẫu lên, nhiều người có thể tối ưu code cho bạn nếu hiểu bạn đang làm cái gì!

 

[tieuthuvodanh1980]

Download Làm việc với ma trận- định thức

 

[siwtom]

'bien doi ma tran thanh ma tran cheo
Public dau As Integer
Public R As Range
Sub ThemMatran()
Dim refer As String
refer = "=" & ActiveSheet.Name & "!" & Selection.Address
tenmang = InputBox("Nhap ten cua ma tran?", "Dat ten cho ma tran")
ActiveWorkbook.Names.add Name:=tenmang, RefersTo:=refer
frmMain.lstMatran.AddItem tenmang
End Sub
Function capMatran(ten, Optional rows) As String
Set R = ActiveWorkbook.Names(ten).RefersToRange
If Not IsMissing(rows) Then
If rows = 1 Then
capMatran = R.rows.Count
Else
capMatran = R.Columns.Count
End If
Else
capMatran = R.rows.Count & "x" & R.Columns.Count
End If
End Function
Sub hoandoihang(A, h1, h2)
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
Currow = R.rows.Count + R.Row: curcot = R.Column
dau = -dau
Cells(Currow + 1, curcot) = "Hoan doi dong " & h1 & " va dong " & h2 & ", dinh thuc co dau " & (dau)
R.Copy
Cells(Currow + 3, curcot).Select
ActiveSheet.Paste
Dim refer As String
refer = "=" & ActiveSheet.Name & "!" & Selection.Address
ActiveWorkbook.Names.add Name:=A, RefersTo:=refer
Set R = ActiveWorkbook.Names(A).RefersToRange
For j = 1 To m
tam = R.Cells(h1, j)
R.Cells(h1, j) = R.Cells(h2, j)
R.Cells(h2, j) = tam
Next

End Sub
Function timphantuso1(A) As String
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
For i = 1 To n
For j = 1 To m
If R.Cells(i, j) = 1 Then timphantuso1 = i & "x" & j: Exit Function
Next
Next
End Function
Sub duaso1vedau(A)
tim1 = timphantuso1(A)
If tim1 <> "1x1" And tim1 <> "" Then
n = Left(tim1, InStr(1, tim1, "x") - 1)
m = Mid(tim1, Len(n) + 2)
Debug.Print n & m
If n <> "1" Then hoandoihang A, 1, Val(n)
If m <> "1" Then hoandoicot A, 1, Val(m)

End If
End Sub


Sub hoandoicot(A, c1, c2)
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
Currow = R.rows.Count + R.Row: curcot = R.Column
dau = -dau
Cells(Currow + 1, curcot) = "Hoan doi cot " & c1 & " va cot " & c2 & ", dinh thuc co dau " & (dau)
R.Copy
Cells(Currow + 3, curcot).Select
ActiveSheet.Paste
Dim refer As String
refer = "=" & ActiveSheet.Name & "!" & Selection.Address
ActiveWorkbook.Names.add Name:=A, RefersTo:=refer
Set R = ActiveWorkbook.Names(A).RefersToRange
For i = 1 To n
tam = R.Cells(i, c1)
R.Cells(i, c1) = R.Cells(i, c2)
R.Cells(i, c2) = tam
Next
End Sub


Sub nhandong1vacong(A, k, d1, d2)
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
Currow = R.rows.Count + R.Row: curcot = R.Column

Cells(Currow + 1, curcot) = "Nhan dong " & d1 & " voi " & k & " va cong voi dong " & d2 & ", co dinh thuc:"
R.Copy
Cells(Currow + 3, curcot).Select
ActiveSheet.Paste
Dim refer As String
refer = "=" & ActiveSheet.Name & "!" & Selection.Address
ActiveWorkbook.Names.add Name:=A, RefersTo:=refer
Set R = ActiveWorkbook.Names(A).RefersToRange
For j = 1 To m
R.Cells(d2, j) = R.Cells(d1, j) * k + R.Cells(d2, j)
Next
End Sub
Sub tes()
duavematrancheo "A"
End Sub
Sub duavematrancheo(A)
Dim matrangoc As Range
dau = 1
Set matrangoc = ActiveWorkbook.Names(A).RefersToRange
duaso1vedau A
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
For j = 1 To m - 1
For i = j + 1 To n
If R.Cells(j, j) = 0 Then
t = timhangcoptkhac0(A, j, j)
If Val(t) > 0 Then
hoandoihang A, j, t
Else
Exit For
End If
End If
If R.Cells(i, j) * R.Cells(j, j) > 0 Then d = -1 Else d = 1
nhandong1vacong A, d * Abs(R.Cells(i, j)) / Abs(R.Cells(j, j)), j, i
Next
Next
Currow = R.rows.Count + R.Row: curcot = R.Column

kq = 1
For i = 1 To n
For j = 1 To m
If i = j Then kq = kq * R.Cells(i, j)
Next
Next
Cells(Currow + 1, curcot) = "Det(" & A & ")=" & kq * dau
On Error Resume Next
Cells(Currow + 2, curcot) = "Sai so: " & Round(Application.WorksheetFunction.MDeterm(matrangoc) - kq * dau, 5)
ActiveWorkbook.Names.add Name:=A, RefersTo:=matrangoc
End Sub
Function timhangcoptkhac0(A, h, c) As Byte
Set R = ActiveWorkbook.Names(A).RefersToRange
n = capMatran(A, 1): m = capMatran(A, 2)
For i = h To n
If R.Cells(i, c) <> 0 Then timhangcoptkhac0 = i: Exit Function
Next
End Function

Thực ra, theo tôi nghĩ, việc biến đổi ma trận về ma trận bậc thang - ma trận tam giác chẳng qua là để tính dễ dàng định thức của ma trận. Việc tính định thức là cần thiết khi ta phải giải hệ n phương trình n ẩn.

Tôi cũng chả cần làm gì nên chưa xem kỹ nhưng Excel có các hàm để tính định thức của ma trận, ma trận nghịch đảo, tích 2 ma trận. Đó là: MDETERM, MINVERSE, MMULT

 

[tieuthuvodanh1980]

Thực ra, theo tôi nghĩ, việc biến đổi ma trận về ma trận bậc thang - ma trận tam giác chẳng qua là để tính dễ dàng định thức của ma trận. Việc tính định thức là cần thiết khi ta phải giải hệ n phương trình n ẩn.

Tôi cũng chả cần làm gì nên chưa xem kỹ nhưng Excel có các hàm để tính định thức của ma trận, ma trận nghịch đảo, tích 2 ma trận. Đó là: MDETERM, MINVERSE, MMULT

Hàm của excel trong nhiều trường hợp ko cho kết quả chính xác, cứ thử rồi sẽ thấy, nhất là kết quả của ma trận nghịch đảo, kết quả của hàm MDETERN cũng chỉ là tương đối, tôi đã chỉnh đc chương trình của mình có thể tìm chính xác kết quả của định thức chứa số nguyên và phân số, số thập phân. chỉ bó tay nếu phần tử của ma trận có chứa căn thức. Nếu là định thức chứa số tphân, phân số, thì kq của excel càng lệch. ví dụ: với mt:
1/2 4/5 8/3
6/5 3/5 1/9
7/3 5/4 6/7
dinh thuc co gia tri: '-6089/37800 trong khi MINVESE :-0.161084656

 

[siwtom]

Hàm của excel trong nhiều trường hợp ko cho kết quả chính xác, cứ thử rồi sẽ thấy, nhất là kết quả của ma trận nghịch đảo, kết quả của hàm MDETERN cũng chỉ là tương đối, tôi đã chỉnh đc chương trình của mình có thể tìm chính xác kết quả của định thức chứa số nguyên và phân số, số thập phân. chỉ bó tay nếu phần tử của ma trận có chứa căn thức. Nếu là định thức chứa số tphân, phân số, thì kq của excel càng lệch. ví dụ: với mt:
1/2 4/5 8/3
6/5 3/5 1/9
7/3 5/4 6/7
dinh thuc co gia tri: '-6089/37800 trong khi MINVESE :-0.161084656

-6089/37800 = -0,16108465608465608465608465608466

MINVESE :-0,161084656

Nếu thế thì sai số là 0,000000000084656084656084656084?

Các phép tính chỉ là +, -, *, /. Với các phân số như trên thì máy sẽ trả về -0,16108465608465608465608465608466 (tất nhiên có làm tròn) chứ làm gì có trả về -6089/37800. Vì có làm gì chăng nữa thì cái giá trị đó sẽ phải được dùng cho một tính toán nào đấy. Bạn có thể viết hàm để trả về string "-6089/37800" nhưng kết quả đó đâu phải dùng để thỏa trí tò mò. Đến khi dùng nó để tính toán tiếp thì máy sẽ tính ra kết quả gần đúng thôi.

Mà tôi đã nói rồi: tôi chưa xem kỹ. Chỉ là ý kiến thôi. Nếu bạn nghiên cứu rồi mà thấy không dùng được thì thôi. Thực ra cách tính định thức thì ai cũng được học trên đại học rồi. Nếu muốn đưa về ma trận tam giác thì cũng chỉ là việc nhân dòng (cột) với hằng số và cộng với dòng khác (cột khác). Mục đích là đưa các phần tử của các dòng "ngắn dần" về 0. Quá trình này theo tôi có lẽ nên dùng đệ quy.

Là nói chơi vậy thôi chứ tôi cũng chả cần để làm gì. Bạn chia sẻ thế là tốt vì có thể ai đó sẽ cần.

 

[tieuthuvodanh1980]

-6089/37800 = -0,16108465608465608465608465608466

MINVESE :-0,161084656

Nếu thế thì sai số là 0,000000000084656084656084656084?

Các phép tính chỉ là +, -, *, /. Với các phân số như trên thì máy sẽ trả về -0,16108465608465608465608465608466 (tất nhiên có làm tròn) chứ làm gì có trả về -6089/37800. Vì có làm gì chăng nữa thì cái giá trị đó sẽ phải được dùng cho một tính toán nào đấy. Bạn có thể viết hàm để trả về string "-6089/37800" nhưng kết quả đó đâu phải dùng để thỏa trí tò mò. Đến khi dùng nó để tính toán tiếp thì máy sẽ tính ra kết quả gần đúng thôi.

Mà tôi đã nói rồi: tôi chưa xem kỹ. Chỉ là ý kiến thôi. Nếu bạn nghiên cứu rồi mà thấy không dùng được thì thôi. Thực ra cách tính định thức thì ai cũng được học trên đại học rồi. Nếu muốn đưa về ma trận tam giác thì cũng chỉ là việc nhân dòng (cột) với hằng số và cộng với dòng khác (cột khác). Mục đích là đưa các phần tử của các dòng "ngắn dần" về 0. Quá trình này theo tôi có lẽ nên dùng đệ quy.

Là nói chơi vậy thôi chứ tôi cũng chả cần để làm gì. Bạn chia sẻ thế là tốt vì có thể ai đó sẽ cần.

Sai số là nhỏ nhưng vẫn là 1 kết quả sai, nếu có thể tính đúng được thì không phải hay hơn là tính gần đúng à? Sai số nhỏ nhưng có nguy hiểm ko? tôi chỉ cần vd đơn giản: gsử bạn là 1 sv, tôi cho bạn tính cái định thức:
1 2 3
4 5 6
7 8 9
bạn tính được kq gần đúng, mặc dù sai số cực nhỏ,MDETERM=6.66134E-16, tôi sẽ ko cho bạn được điểm nào cả. Lúc đó bạn có giải thích gì nữa không?

 

[siwtom]

Sai số là nhỏ nhưng vẫn là 1 kết quả sai, nếu có thể tính đúng được thì không phải hay hơn là tính gần đúng à? Sai số nhỏ nhưng có nguy hiểm ko? tôi chỉ cần vd đơn giản: gsử bạn là 1 sv, tôi cho bạn tính cái định thức:
1 2 3
4 5 6
7 8 9
bạn tính được kq gần đúng, mặc dù sai số cực nhỏ,MDETERM=6.66134E-16, tôi sẽ ko cho bạn được điểm nào cả. Lúc đó bạn có giải thích gì nữa không?

Tôi đã nói rõ là tôi chưa tìm hiểu sâu. Bạn đã tìm hiểu và nói nó tính có sai số. Tôi có bác bỏ đâu? Tôi chỉ chỉ ra sai số thuộc cấp nào. Nếu với công việc của bạn bạn thấy cái sai số đó vẫn là quá lớn thì bạn tìm cách khác. Còn nếu tôi thấy với vấn đề cụ thể không cần độ chính xác tới mức đó thì lại là chuyện của tôi. Bạn viết code, người khác cũng viết bởi với vấn đề cụ thể nào đó Excel không thỏa mãn bạn, không thỏa mãn người khác. Vậy thì nếu cần thì bạn cũng làm tương tự với ma trận. Excel không đáp ứng được thì tự viết code. Thế thôi.
Hồi tôi đi học thì tôi tính định thức bằng tay bạn ạ. Không có Excel hay cái gì làm thay cả. Cũng chả có viết code cho máy tính vì có đâu. Nếu bây giờ cần làm mà ông thầy yêu cầu phải tính ra là 2 / 3 chứ không phải ... thì tôi sẽ làm để tính chính xác. Còn nếu ông thầy không yêu cầu chính xác tới 1 phần tỷ thì tôi sẽ làm cách "lười biếng". Thế thôi. Tùy nhu cầu của ông thầy mà tôi làm cho ông sướng.