Xin hướng dẫn chuyển dữ liệu sang sheet mới theo thứ tự tên người phụ trách (1 người xem)

[FATA11]

Xin chào mọi người.
em có file dữ liệu như đính kèm,
sau khi nhập dữ liệu từ sheet "nhap" thì muốn dữ liệu sẽ chuyển sang sheet "quanly" nhưng phải theo thứ tự tên người phụ trách.
Tên người phụ trách sắp xếp theo thứ tự A-Z
Mong mọi người giúp đỡ ạ.

 

[bebo021999]

Xài đỡ code này. Khi chọn sheet "quanly" thi code sẽ chạy.

Option Explicit
Private Sub Worksheet_Activate()
Dim lr&, i&, k&, yr&, n&, mo&, rng, sp, res(1 To 10000, 1 To 5)
Dim dic As Object, key, nbd As Date, nkt As Date, ce As Range
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("nhap")
    lr = .Cells(Rows.Count, "S").End(xlUp).Row
    rng = .Range("B3:S" & lr).Value
    For i = 1 To UBound(rng)
        If rng(i, 18) = .Range("T1").Value Then
            If Not dic.exists(rng(i, 13)) Then
                dic.Add rng(i, 13), i
            Else
                dic(rng(i, 13)) = dic(rng(i, 13)) & "|" & i
            End If
        End If
    Next
End With
For Each key In dic.keys
    For Each sp In Split(dic(key), "|")
        k = k + 1: res(k, 2) = key
        res(k, 1) = rng(sp, 1): res(k, 3) = rng(sp, 2)
        res(k, 4) = rng(sp, 4): res(k, 5) = rng(sp, 5)
    Next
Next
With Range("B3:AC1000")
    .ClearContents
    .ClearFormats
End With
If k = 0 Then Exit Sub
Range("A3").Resize(k, 5).Value = res
For Each ce In Range("F3:AC" & 2 + k)
    If ce.Column = 6 Then yr = Range("F1").Value
    If ce.Column = 18 Then yr = Range("R1").Value
    Select Case ce.Column
        Case Is >= 18
            yr = Range("R1").Value
            mo = ce.Column - 17
        Case Is >= 6
            yr = Range("F1").Value
            mo = ce.Column - 5
    End Select
    nbd = Cells(ce.Row, 4).Value: nkt = Cells(ce.Row, 5).Value
    n = DateDiff("m", nbd, nkt) + 1
    If 29 - ce.Column < n Then n = 29 - ce.Column
    If Year(nbd) = yr And Month(nbd) = mo Then
        ce.Value = Cells(ce.Row, 1).Value
        If n > 0 Then ce.Resize(1, n).Interior.Color = vbGreen
    End If
Next
End Sub

 

[FATA11]

Xài đỡ code này. Khi chọn sheet "quanly" thi code sẽ chạy.

Option Explicit
Private Sub Worksheet_Activate()
Dim lr&, i&, k&, yr&, n&, mo&, rng, sp, res(1 To 10000, 1 To 5)
Dim dic As Object, key, nbd As Date, nkt As Date, ce As Range
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("nhap")
    lr = .Cells(Rows.Count, "S").End(xlUp).Row
    rng = .Range("B3:S" & lr).Value
    For i = 1 To UBound(rng)
        If rng(i, 18) = .Range("T1").Value Then
            If Not dic.exists(rng(i, 13)) Then
                dic.Add rng(i, 13), i
            Else
                dic(rng(i, 13)) = dic(rng(i, 13)) & "|" & i
            End If
        End If
    Next
End With
For Each key In dic.keys
    For Each sp In Split(dic(key), "|")
        k = k + 1: res(k, 2) = key
        res(k, 1) = rng(sp, 1): res(k, 3) = rng(sp, 2)
        res(k, 4) = rng(sp, 4): res(k, 5) = rng(sp, 5)
    Next
Next
With Range("B3:AC1000")
    .ClearContents
    .ClearFormats
End With
If k = 0 Then Exit Sub
Range("A3").Resize(k, 5).Value = res
For Each ce In Range("F3:AC" & 2 + k)
    If ce.Column = 6 Then yr = Range("F1").Value
    If ce.Column = 18 Then yr = Range("R1").Value
    Select Case ce.Column
        Case Is >= 18
            yr = Range("R1").Value
            mo = ce.Column - 17
        Case Is >= 6
            yr = Range("F1").Value
            mo = ce.Column - 5
    End Select
    nbd = Cells(ce.Row, 4).Value: nkt = Cells(ce.Row, 5).Value
    n = DateDiff("m", nbd, nkt) + 1
    If 29 - ce.Column < n Then n = 29 - ce.Column
    If Year(nbd) = yr And Month(nbd) = mo Then
        ce.Value = Cells(ce.Row, 1).Value
        If n > 0 Then ce.Resize(1, n).Interior.Color = vbGreen
    End If
Next
End Sub

Em xin cảm ơn ạ