bangkd
Thành viên chính thức
- Tham gia
- 16/3/08
- Bài viết
- 76
- Được thích
- 85
Tôi cũng nghĩ sẽ kết hợp các hàm dò tìm (Index, Match, Vlookup,....). Tuy nhiên, bạn có thể giải thích thêm ý nghĩa của các ma trận K1,2. Tôi chưa hiểu 2 ma trận đó nên không biết áp dụng thế nào vào công thức.
Tôi không thấy chỉ số cột và hàng của K1 và K2. Cụ thể, ô B69 của ma trận K có chỉ số cột là u3 và u3, có thể ký hiệu là K(u3, u3).
Còn bạn thử nói ô G26 của K1 có chỉ số cột là gì và dòng là gì? không có các thông số đó, thì không ai tính được cả.
Option Base 1
'' ..............
Function Matrix(sRow, sCol, RngK1, RowK1, ColK1, RngK2, RowK2, ColK2)
Dim ArrRngK1, ArrRngK2, ArrRowK1, ArrColK1, ArrRowK2, ArrColK2
Set ArrRngK1 = RngK1: Set ArrRngK2 = RngK2
Set ArrRowK1 = RowK1: Set ArrColK1 = ColK1
Set ArrRowK2 = RowK2: Set ArrColK2 = ColK2
Matrix = 0
For i = 1 To ArrRowK1.Rows.Count
For j = 1 To ArrRowK1.Columns.Count
If ArrRowK1(i, j) = sRow Then
For l = 1 To ArrColK1.Columns.Count
For k = 1 To ArrColK1.Rows.Count
If ArrColK1(k, l) = sCol Then
Matrix = Matrix + ArrRngK1(i, l)
Exit For
End If
Next
Next
Exit For
End If
Next
Next
For x = 1 To ArrRowK2.Rows.Count
For y = 1 To ArrRowK2.Columns.Count
If ArrRowK2(x, y) = sRow Then
For t = 1 To ArrColK2.Columns.Count
For z = 1 To ArrColK2.Rows.Count
If ArrColK2(z, t) = sCol Then
Matrix = Matrix + ArrRngK2(x, t)
Exit For
End If
Next
Next
Exit For
End If
Next
Next
End Function
Function Matrix(sRow, sCol, RngK1, RowK1, ColK1, RngK2, RowK2, ColK2)
Dim ArrRngK1, ArrRngK2, ArrRowK1, ArrColK1, ArrRowK2, ArrColK2
ArrRngK1 = RngK1: ArrRngK2 = RngK2
ArrRowK1 = RowK1: ArrColK1 = ColK1
ArrRowK2 = RowK2: ArrColK2 = ColK2
Matrix = 0
For i = 1 To RowK1.Rows.Count - 1
For j = 1 To RowK1.Columns.Count
If ArrRowK1(i, j) = sRow Then
phantu = ArrRowK1(RowK1.Rows.Count, j)
For l = 1 To ColK1.Columns.Count - 1
For k = 1 To ColK1.Rows.Count
If ArrColK1(k, l) = sCol And ArrColK1(k, ColK1.Columns.Count) = phantu Then
Matrix = Matrix + ArrRngK1(i, l)
phantu = ""
Exit For
End If
Next
Next
Exit For
End If
Next
Next
For x = 1 To RowK2.Rows.Count - 1
For y = 1 To RowK2.Columns.Count
If ArrRowK2(x, y) = sRow Then
phantu = ArrRowK2(RowK2.Rows.Count, y)
For t = 1 To ColK2.Columns.Count - 1
For z = 1 To ColK2.Rows.Count
If ArrColK2(z, t) = sCol And ArrColK2(z, ColK2.Columns.Count) = phantu Then
Matrix = Matrix + ArrRngK2(x, t)
phantu = ""
Exit For
End If
Next
Next
Exit For
End If
Next
Next
End Function
Function Matrix2(sRow, sCol, RngK1, RowK1, ColK1, RngK2, RowK2, ColK2)
Dim ArrRngK1, ArrRngK2, ArrRowK1, ArrColK1, ArrRowK2, ArrColK2
Dim PTD1, PTD2, PTC1, PTC2, vitriPTDong, vitriPTCot, phantu, ColIndex
Set ArrRngK1 = RngK1: Set ArrRngK2 = RngK2
Set ArrRowK1 = RowK1.Resize(1): Set ArrColK1 = ColK1.Resize(1)
Set PTD1 = RowK1.Resize(1).Offset(RowK1.Rows.Count - 1, 0)
Set PTC1 = ColK1.Resize(, 1).Offset(0, ColK1.Columns.Count - 1)
Set ArrRowK2 = RowK2.Resize(1): Set ArrColK2 = ColK2.Resize(1)
Set PTD2 = RowK2.Resize(1).Offset(RowK2.Rows.Count - 1, 0)
Set PTC2 = ColK2.Resize(, 1).Offset(0, ColK2.Columns.Count - 1)
Matrix2 = 0
For i = 0 To RowK1.Rows.Count - 2
If Not ArrRowK1.Offset(i, 0).Find(sRow) Is Nothing Then
vitriPTDong = Application.Match(sRow, ArrRowK1.Offset(i, 0), 0)
phantu = PTD1(1, vitriPTDong)
vitriPTCot = Application.Match(phantu, PTC1, 0) - 1
If Not ArrColK1.Offset(vitriPTCot, 0).Find(sCol) Is Nothing Then
ColIndex = Application.Match(sCol, ArrColK1.Offset(vitriPTCot, 0), 0)
Matrix2 = Matrix2 + RngK1(i + 1, ColIndex)
End If
End If
vitriPTDong = "": vitriPTCot = "": phantu = "": ColIndex = ""
Next
For i = 0 To RowK2.Rows.Count - 2
If Not ArrRowK2.Offset(i, 0).Find(sRow) Is Nothing Then
vitriPTDong = Application.Match(sRow, ArrRowK2.Offset(i, 0), 0)
phantu = PTD2(1, vitriPTDong)
vitriPTCot = Application.Match(phantu, PTC2, 0) - 1
If Not ArrColK2.Offset(vitriPTCot, 0).Find(sCol) Is Nothing Then
ColIndex = Application.Match(sCol, ArrColK2.Offset(vitriPTCot, 0), 0)
Matrix2 = Matrix2 + RngK2(i + 1, ColIndex)
End If
End If
vitriPTDong = "": vitriPTCot = "": phantu = "": ColIndex = ""
Next
End Function
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2