Option Explicit
Sub ChietTinh()
Dim Rws As Long, jJ As Byte
Dim Rng As Range, Cls As Range, sRng As Range, Rg As Range, Rg0 As Range
Dim WF As Object, StrC As String
ReDim MSD(1 To 3) As Double
Rws = [d65500].End(xlUp).Row
Set Rng = [A3].Resize(Rws).SpecialCells(xlCellTypeConstants, 1)
Set WF = Application.WorksheetFunction
For Each Cls In Rng
Set Rg = Range(Cls, Cls.End(xlDown).Offset(-1)).Offset(, 3)
If Rg.Count > 99 Then Set Rg = Cls.Resize(19)
For jJ = 1 To 4
StrC = [AA1].Resize(4)(jJ).Value
Set sRng = Rg.Find(StrC, , xlValues, xlWhole)
If Not sRng Is Nothing Then
If jJ = 1 Then
MSD(1) = sRng.Offset(, 5).Value
ElseIf jJ = 2 And sRng.Offset(1, 5).Value > 0 Then
With sRng.Offset(, 3)
MSD(2) = .Offset(1, 2).Value * .Value
.Offset(, 2).Value = MSD(2)
.Interior.ColorIndex = 34
End With
ElseIf jJ = 3 And sRng.Offset(1, 5).Value > 0 Then
Set Rg0 = Range(sRng.Offset(1, -1), sRng.Offset(1, -1).End(xlDown)).Offset(, 6)
MsgBox Rg0.Address, , sRng.Offset(1, 5).Value
With sRng.Offset(, 5)
MSD(3) = .Offset(, -2).Value * WF.Sum(Rg0)
.Value = MSD(3)
.Interior.ColorIndex = 35
End With
ElseIf jJ = 4 Then
sRng.Offset(, 5).Value = (MSD(1) + MSD(2) + MSD(3)) * 0.015
MSD(1) = 0: MSD(2) = 0: MSD(3) = 0
End If
End If
Next jJ
Next Cls
End Sub
Sub THDanhSachCongViec()
Dim Sh As Worksheet, Rng As Range, sRng As Range, Rg0 As Range, Cls As Range
Dim jJ As Byte, Rws As Long
Dim Loai As String
Set Sh = ThisWorkbook.Worksheets("DonGiaChiTiet")
Sheets("KetQua").Select
Rws = Sh.[d65500].End(xlUp).Row
Set Rng = Sh.[A3].Resize(Rws).SpecialCells(xlCellTypeConstants, 1)
[a5].Resize(Rws, 6).ClearContents 'Xóa'
For Each Cls In Rng
With Cells(Rws, "A").End(xlUp).Offset(1)
.Value = Cls.Value
.Offset(, 1).Value = Cls.Offset(, 3).Value
Set Rg0 = Range(Cls, Cls.End(xlDown)).Offset(, 3)
For jJ = 1 To 4
Loai = [b4].Offset(, jJ).Value
Set sRng = Rg0.Find(Loai, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
.Offset(, 1 + jJ).Value = sRng.Offset(, 5).Value
End If
Next jJ
End With
Next Cls
End Sub
