Nhờ thầy, cô, anh, chị lập giúp code VBA file tính tổng hợp lương (tính theo thời gian)

[hoangminh2018]

Em có file này nhờ thầy cô, anh, chị lập giúp tính tổng thu nhập và lương phải trả bằng code VBA theo khỏang thời gian (em có mô tả trong file sheets(THLuong).
Cảm ơn thầy, cô, anh, chị nhiều.

 

[hoangminh2018]

Các anh leonguyenz, HieuCD, thầy ơi có thể ra tay giúp em bài này không.

 

[hoangminh2018]

Chắc bài này khó quá phải không ạ, hay là diễn giải của em có vấn đề làm mọi người không hiểu ý.

 

[leonguyenz]

Chắc bài này khó quá phải không ạ, hay là diễn giải của em có vấn đề làm mọi người không hiểu ý.

Nếu 1 học viên học nhiều hơn 1 lớp (Piano, Violon,...) thì sao? Vì nếu lọc duy nhất học viên thì không cần cột Lớp.

 

[hoangminh2018]

Nếu 1 học viên học nhiều hơn 1 lớp (Piano, Violon,...) thì sao? Vì nếu lọc duy nhất học viên thì không cần cột Lớp.

Nếu vậy thì tách ra giúp em ạ.

 

[leonguyenz]

Nếu vậy thì tách ra giúp em ạ.

Tham khảo code sau:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sArr(), i As Long, k As Long, Dic As Object
Dim reArr(), Tmp As String, iTmp As String
sArr = Sheet5.Range("B5:L" & Sheet5.Range("B65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To 7)
Set Dic = CreateObject("Scripting.Dictionary")
If Not Intersect(Target, Range("C3")) Is Nothing Then
    Range("A11:G65535").ClearContents
    For i = 1 To UBound(sArr, 1)
        If sArr(i, 6) = Target.Value Then
            If sArr(i, 1) >= Range("C5") And sArr(i, 1) <= Range("E5") Then
                Tmp = sArr(i, 2) & "|" & sArr(i, 4)
                If Not Dic.Exists(Tmp) Then
                    k = k + 1: Dic.Add Tmp, k
                    reArr(k, 1) = k: reArr(k, 2) = sArr(i, 2)
                    reArr(k, 3) = sArr(i, 3): reArr(k, 4) = sArr(i, 4)
                    reArr(k, 5) = 1: reArr(k, 6) = sArr(i, 10)
                    reArr(k, 7) = sArr(i, 11)
                Else
                    iTmp = Dic.Item(Tmp)
                    reArr(iTmp, 5) = reArr(iTmp, 5) + 1
                    reArr(iTmp, 6) = reArr(iTmp, 6) + sArr(i, 10)
                    reArr(iTmp, 7) = reArr(iTmp, 7) + sArr(i, 11)
                End If
            End If
        End If
    Next i
    If k Then Range("A11").Resize(k, 7) = reArr
End If
End Sub

 

[hoangminh2018]

Tham khảo code sau:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sArr(), i As Long, k As Long, Dic As Object
Dim reArr(), Tmp As String, iTmp As String
sArr = Sheet5.Range("B5:L" & Sheet5.Range("B65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To 7)
Set Dic = CreateObject("Scripting.Dictionary")
If Not Intersect(Target, Range("C3")) Is Nothing Then
    Range("A11:G65535").ClearContents
    For i = 1 To UBound(sArr, 1)
        If sArr(i, 6) = Target.Value Then
            If sArr(i, 1) >= Range("C5") And sArr(i, 1) <= Range("E5") Then
                Tmp = sArr(i, 2) & "|" & sArr(i, 4)
                If Not Dic.Exists(Tmp) Then
                    k = k + 1: Dic.Add Tmp, k
                    reArr(k, 1) = k: reArr(k, 2) = sArr(i, 2)
                    reArr(k, 3) = sArr(i, 3): reArr(k, 4) = sArr(i, 4)
                    reArr(k, 5) = 1: reArr(k, 6) = sArr(i, 10)
                    reArr(k, 7) = sArr(i, 11)
                Else
                    iTmp = Dic.Item(Tmp)
                    reArr(iTmp, 5) = reArr(iTmp, 5) + 1
                    reArr(iTmp, 6) = reArr(iTmp, 6) + sArr(i, 10)
                    reArr(iTmp, 7) = reArr(iTmp, 7) + sArr(i, 11)
                End If
            End If
        End If
    Next i
    If k Then Range("A11").Resize(k, 7) = reArr
End If
End Sub

Dạ em đã chạy thử kết quả OK ạ, em cảm ơn anh nhiều, vì em mới làm quen với VBA mà khả năng em hơi chậm, để em cố gắng về suy nghĩ rồi tự hiểu nếu phần nào không hiểu anh có thể giải thích giúp em không ạ.