Nhờ dịch dùm Macro giải hệ phương trình tuyến tính ba ẩn

[SA_DQ]

Đây là macro dùng để giải hệ phương trình tuyến tính ba ẩn bằng cách xác định định thức. Nhờ bạn nào phiên dịch giúp các dòng lệnh.

Sub Matrix3()
 Dim bj As Byte, Fnc As Object:     Dim Dd As Double
 Dim Rng As Range, dRng As Range, rTemp As Range
1
 Set Rng = [b1].Resize(3, 3)
3 Set Fnc = Application.WorksheetFunction
 Dd = Fnc.MDeterm(Rng):       [f1].Resize(9, 9).Clear
5 Set dRng = [iV1].End(xlToLeft).Resize(3)
 For bj = 7 To 9
7   [g1].Resize(3, 3) = Rng.Value
   Cells(1, bj).Resize(3) = dRng.Value
9   Set rTemp = [g1].Resize(3, 3)
   Cells(bj - 2, 6) = Fnc.MDeterm(rTemp) / Dd
 Next bj
End Sub

Trên trang tính mới, ta có những số liệu sau :

             B      c      D        E
1           12     3       5      100 
2            -5    -4      5      -57
3           -1     19      4       45

Sau khi chạy macro ta sẽ biết kết quả ưng ý

 

[LearnExcel]

Trả lời

Sub Matrix3()
    Dim bj As Byte, Fnc As Object: Dim Dd As Double
    Dim Rng As Range, dRng As Range, rTemp As Range

Set Rng = [b1].Resize(3, 3)
'đặt vùng Rng = “B1: D3” '
Set Fnc = Application.WorksheetFunction
'đặt Fnc tham chiếu cho đối tượng hàm Worksheet '
Dd = Fnc.MDeterm(Rng):
'tính định thức cho ma trận Rng '
[f1].Resize(9, 9).Clear
    'xóa dữ liệu vùng “F1:N9” '
Set dRng = [iV1].End(xlToLeft).Resize(3)
'đặt dRng = vùng ô iV1 (version 2007 mới có ô này) tới cột cuối và 3 hàng xuống _
 (tôi có thử thay iV1 bằng O1, kết quả không đổi) '
    For bj = 7 To 9
'biến số bj từ 7 đến 9 '
        [g1].Resize(3, 3) = Rng.Value
'gán vùng “G1:I3” = giá trị vùng Rng '
        Cells(1, bj).Resize(3) = dRng.Value
'Gán vùng G1:G3 (đến I1:I3) = giá trị vùng dRng (rỗng) '
        Set rTemp = [g1].Resize(3, 3)
'Gán mảng tạm rTemp = giá trị vùng G1:I3 '
        Cells(bj - 2, 6) = Fnc.MDeterm(rTemp) / Dd
'Gán ô F5-F7 = giá trị định thức (rtemp)/DD '
Next bj
'Thoát lặp '
End Sub

 

[phamduylong]

'đặt dRng = vùng ô iV1 (version 2007 mới có ô này) tới cột cuối và 3 hàng xuống _ 
(tôi có thử thay iV1 bằng O1, kết quả không đổi)

to LearnExcel: Ô IV1 chính là ô đầu tiên của cột 256 (cột cuối cùng của bảng tính Excel 2003 trở về trước). Excel nào chẳng có ?

 

[SA_DQ]

'đặt dRng = vùng ô iV1 (version 2007 mới có ô này) tới cột cuối và 3 hàng xuống _ 
(tôi có thử thay iV1 bằng O1, kết quả không đổi)

to LearnExcel: Ô IV1 chính là ô đầu tiên của cột 256 (cột cuối cùng của bảng tính Excel 2003 trở về trước). Excel nào chẳng có ?

Vậy là dòng này dịch chưa được thoát ý;
Bỡi chính chưa thoát nên phía dưới sẽ sai (?)
Có lẽ trên sai 1 xíu, làm cho mấy dòng dịch bên dưới chưa chuẩn lắm.

Câu trước khi thoát vòng lặp là để ghi nghệm hệ phương trình đó.

 

[phamduylong]

Set dRng = [iV1].End(xlToLeft).Resize(3)

Gán biến dRng cho ô cuối cùng bên trái End(xlToLeft) của ô IV1 (là ô E1) và mở rộng xuống 3 dòng Resize(3).
Kết quả dRng=E1:E3

 

[ptm0412]

Phải đánh vật với nó cả buổi, toát cả mồ hôi mẹ mồ hôi con! Bác Sa chấm điểm dùm em:

Sub Matrix3() 
    Dim bj As Byte, Fnc As Object: Dim Dd As Double 
    Dim Rng As Range, dRng As Range, rTemp As Range 
 
Set Rng = [b1].Resize(3, 3) 
'đặt vùng Rng = “B1: D3” ' 
Set Fnc = Application.WorksheetFunction 
'đặt giá trị biến Fnc là đối tượng hàm Worksheet ' 
Dd = Fnc.MDeterm(Rng): 
'tính định thức cho ma trận Rng (“B1: D3”) ' 
[f1].Resize(9, 9).Clear 
          'xóa dữ liệu vùng “F1:N9” ' 
Set dRng = [iV1].End(xlToLeft).Resize(3) 
'đặt dRng = vùng: cột cuối có dữ liệu (cột E) với 3 dòng 
=> dRng = "E1:E3"' 
    For bj = 7 To 9 
' Khởi động vòng lặp for với biến bj từ 7 đến 9 (chạy 3 vòng)' 
        [g1].Resize(3, 3) = Rng.Value 
'gán giá trị vùng “G1:I3” = giá trị vùng Rng (“B1: D3”) ' 
        Cells(1, bj).Resize(3) = dRng.Value 
'Gán giá trị vùng lần lượt trong mỗi vòng lặp G1:G3, H1:H3, đến I1:I3) = giá trị
 vùng dRng "E1:E3" (100, -57, 45) ' 
        Set rTemp = [g1].Resize(3, 3) 
'Gán mảng tạm rTemp = giá trị vùng G1:I3 ' 
        Cells(bj - 2, 6) = Fnc.MDeterm(rTemp) / Dd 
'Gán ô F5-F7 = giá trị định thức (rtemp)/Dd ' 
Next bj 
'Tiếp tục vòng lặp kế' 
End Sub

Ý nghĩa:
- Tính định thức ma trận 3x3 tạm gọi là ma trận hệ số A, gán vào biến Dd
- Lần lượt thay ma trận cột Y (côt thứ 4 của ma trận hệ phương trình) vào từng cột 1, 2, 3 của ma trận hệ số A
- Mỗi lần thay, tính lại định thức ma trận mới, chia cho Dd, ra 1 nghiệm
- Thay 3 lần cho ra 3 nghiệm
- Gán kết quả vào các ô tương ứng (F5-F7 )

 

[SA_DQ]

Phải đánh vật với nó cả buổi, toát cả mồ hôi mẹ mồ hôi con! Bác Sa chấm điểm dùm em:
[COLOR=#0000bb
[COLOR=black]Ý nghĩa:
- Tính định thức ma trận 3x3 tạm gọi là ma trận biến X, gán vào biến Dd
- Lần lượt thay ma trận cột Y (côt thứ 4 của ma trận hệ phương trình) vào từng cột 1, 2, 3 của ma trận biến X
- Mỗi lần thay, tính lại định thức ma trận mới, chia cho Dd, ra 1 nghiệm
- Thay 3 lần cho ra 3 nghiệm
- Gán kết quả vào các ô tương ứng (F5-F7 )
[/COLOR][/COLOR]

Quá chuẩn luôn! Xứng đáng nhận quà thưởng rồi!
(Hãy tùy chọn phương thức nhận quà, giúp cái!)

Với mọi người: Có thể viết hàm được không vậy, ta?

 

[ptm0412]

Còn sai một chút bác ạ. Ma trận 3x3 em gọi tên sai (dù đã ăn gian: chỉ gọi tạm), đó không phải ma trận biến X mà là ma trận hệ số A.
Ma trận hệ số A = {a11, a12, a13
-------------------a21, a22, a23
-------------------a31, a32, a33}
Ma trận biến X là ma trận dòng {x1, x2, x3}
Ma trận giá trị Y đúng là ma trận cột {y1; y2; y3}, và với phép tính nhân ma trận ta có: Y = A . X

Quà Bác gởi Email cho em, em để dành. Chả mấy khi được Bác khen nhất là trong Box của Bác.

 

[LearnExcel]

Với mọi người: Có thể viết hàm được không vậy, ta?

Đây là giải thích code, nhưng em nghĩ giải toán hệ PT nhiều ẩn thì làm bằng công thức ( như =MMULT(MINVERSE(B13),E1:E3)) trong bảng tính có lẽ hiệu quả hơn nhiều so với hàm VBA. Kết quả ra y chang như của bác tính bằng VBA nhưng hay hơn la ra kết quả "online". Bác Thay dữ kiện là ra kết quả ngay , khỏi bấm chạy Mảco cho phiền phức. Em post lại file giải hệ pt 23 ẩn.

Nếu vẫn tha thiết VBA ,theo em bác thử xài Application.WorksheetFunction.MMULT, MINVERSE xem code có ngắn hơn không vì bác đang dùng hàm MDeterm mà. (em vẫn tâm đắc với vụ "không nên phát minh lại ra bánh xe" Re-invent the wheel" ). Hơn nữa, hàm của bác "Hard Code" với hệ PT 3 ẩn, bác nên thêm biến số ẩn cho linh động, đỡ công viết lại cho 4, 5 .. ẩn.

Còn code của bác nên có phần "house keeping" như
Set Fnc = Nothing
Set rTemp = Nothing
...