[Help] VBA sắp xếp sắp xếp các Quận theo thứ tự ngày của từng Nhân Viên

[ngoctuyen1995]

Thân chào cả nhà GPEX!

Mong cả nhà giúp em một việc ạ.
em có file data gồm 02 Sheet Data và Ketqua, em muốn tạo một code VBA để tự động thực hiện theo điều kiện

Điều kiện: cột Local = "TIER 2" và sắp xếp các cột QUAN theo thứ tự cột Audit Day của từng FA name. Ngày nào trước thì sẽ ưu tiên xếp trước

em có làm thử kết quả ở sheet KetQua

Mong cả nhà giúp đỡ.. Em chân thành cảm ơn ạ...

 

[huuthang_bd]

Dữ liệu của bạn có một số ô dư khoảng trắng nhé (Cột Local).

Sub ngoctuyen1995()
Dim aData As Variant, aResult() As Variant, sLocal As String, oDic As Object, i As Long, x As Long, k As Long
sLocal = InputBox("Local?", , "TIER 2")
If sLocal = "" Then Exit Sub
aData = Sheets("Data").Range("A1", Sheets("Data").Cells(&H100000, "K").End(xlUp)).Value
ReDim aResult(1 To UBound(aData, 1), 1 To 4)
Set oDic = VBA.CreateObject("Scripting.Dictionary")
For i = 2 To UBound(aData, 1)
    If aData(i, 6) = sLocal Then
        If oDic.Exists(aData(i, 9)) Then
            x = oDic.Item(aData(i, 9))
            aResult(x, 4) = aResult(x, 4) & "|" & Format(aData(i, 11), "yymmdd") & aData(i, 3)
        Else
            k = k + 1
            oDic.Add aData(i, 9), k
            aResult(k, 1) = aData(i, 9)
            aResult(k, 2) = aData(i, 10)
            aResult(k, 3) = sLocal
            aResult(k, 4) = Format(aData(i, 11), "yymmdd") & aData(i, 3)
        End If
    End If
Next
For i = 1 To k
    aResult(i, 4) = SortStr(aResult(i, 4))
Next
Sheets("KetQua").UsedRange.Offset(1).ClearContents
If k > 0 Then Sheets("KetQua").Range("A2").Resize(k, UBound(aResult, 2)).Value = aResult
End Sub
Private Function SortStr(ByVal Str As String)
Dim Arr As Variant, i As Long, j As Long, sTmp As String
Arr = Split(Str, "|")
For i = 0 To UBound(Arr, 1)
    For j = i + 1 To UBound(Arr, 1)
        If Left(Arr(j), 6) < Left(Arr(i), 6) Then
            sTmp = Arr(i): Arr(i) = Arr(j): Arr(j) = sTmp
        End If
    Next
    Arr(i) = Mid(Arr(i), 7)
Next
SortStr = Join(Arr, " - ")
End Function