Option Explicit
[B]Sub TongHop()[/B]
Dim Sh As Worksheet, Cls As Range, Rng As Range, sRng As Range, Rg0 As Range
Dim jJ As Long, eRw As Long, Col As Byte, Cot As Byte
Dim MyAdd As String, StrC As String: Const CT As String = "-"
Sheets("YC2").Select: Set Sh = Sheets("Data")
Set Rng = Sh.Range(Sh.[k4], Sh.[iv4].End(xlToLeft))
1 ' Chép Các Ma "C*" Cua DATA Vo Bién:'
For Each Cls In Rng
StrC = StrC & Right(CT & Cls.Value, 3)
Next Cls
Set Rng = Sh.Range(Sh.[c4], Sh.[c65500].End(xlUp))
eRw = [a65500].End(xlUp).Row
2 ' Xóa Du Lieu Cu:'
[C7].Resize(eRw, 250).ClearContents
3 'Tao Vòng lap Duyet Theo Ma "A*" Cua YC2:'
For Each Cls In Range([D4], [iv4].End(xlToLeft))
Col = Cls.Column
4 'Tao Vòng lap Duyet Dén Hét Các Hàng Cua YC2:'
For jJ = 7 To eRw
If Cells(jJ, Col).Interior.ColorIndex < 9 Then
5 'Xác Dinh Cot Chúa Du Lieu Càn Tìm Tai DATA So Vói Chuan:'
Cot = InStr(StrC, Cells(jJ, "A").Value) \ 3
Set sRng = Rng.Find([B2].Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
If Sh.Cells(sRng.Row, "I").Value = [B3].Value Then
Cells(jJ, Col).Value = Cells(jJ, Col).Value + _
Sh.Cells(sRng.Row, "K").Offset(, Cot).Value
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
End If
Next jJ
Next Cls
[B]End Sub[/B]
