Thống kê số NV ứng với công việc?

[Cô gái 1m52]

Xin chào các bạn,
Tôi có một bảng dữ liệu đầu vào maxnv, và công việc như cột A,B.
Mong các bạn giúp đỡ tôi thống kê số nhân viên và mã nv đưa vào cột F,G
Cảm ơn các bạn.

 

[HieuCD]

Cảm ơn bạn đã làm thêm chức năng so sánh giúp mình dễ quan sát, code mình lấy của bạn Snow25 là code ở bài 18 bạn ạ.
Hình như là bạn đang lấy code ở bài 16 nên kết quả 2 code mới trùng nhau như vậy.

Xóa bớt vài lệnh

Sub XYZ()
  Dim dic As Object, sArr(), aCV(), arr As Variant, Res()
  Dim sRow&, i&, k&, ik&, iKey$, iKey2$, tmp$
 
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("TK")
    sArr = .Range("A2", .Range("C" & Rows.Count).End(xlUp)).Value
    aCV = .Range("E2", .Range("E" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Preserve sArr(1 To sRow, 1 To 4)
  For i = 1 To sRow
    iKey2 = sArr(i, 2)
    If Not dic.exists(iKey2) Then dic.Add iKey2, Array(0, ",")
    arr = dic.Item(iKey2)
    iKey = sArr(i, 2) & "#" & sArr(i, 1)
    If Not dic.exists(iKey) Then
      dic.Add iKey, i
      sArr(i, 4) = sArr(i, 1) & "[" & sArr(i, 3) & "]"
      arr(0) = arr(0) + 1
      arr(1) = arr(1) & sArr(i, 4) & ","
    Else
      ik = dic.Item(iKey)
      sArr(ik, 3) = sArr(i, 3) + sArr(ik, 3)
      tmp = sArr(i, 1) & "[" & sArr(ik, 3) & "]"
      arr(1) = Replace(arr(1), "," & sArr(ik, 4) & ",", "," & tmp & ",")
      sArr(ik, 4) = tmp
    End If
    dic.Item(iKey2) = arr
  Next i
  sRow = UBound(aCV)
  ReDim Res(1 To sRow, 1 To 2)
  For i = 1 To sRow
    iKey2 = aCV(i, 1)
    If dic.exists(iKey2) Then
      arr = dic.Item(iKey2)
      Res(i, 1) = arr(0)
      Res(i, 2) = Mid(arr(1), 2, Len(arr(1)) - 2)
    End If
  Next i
  Sheets("TK").Range("H2").Resize(sRow, 2) = Res
End Sub

 

[Cô gái 1m52]

Xóa bớt vài lệnh

Sub XYZ()
  Dim dic As Object, sArr(), aCV(), arr As Variant, Res()
  Dim sRow&, i&, k&, ik&, iKey$, iKey2$, tmp$

  Set dic = CreateObject("scripting.dictionary")
  With Sheets("TK")
    sArr = .Range("A2", .Range("C" & Rows.Count).End(xlUp)).Value
    aCV = .Range("E2", .Range("E" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Preserve sArr(1 To sRow, 1 To 4)
  For i = 1 To sRow
    iKey2 = sArr(i, 2)
    If Not dic.exists(iKey2) Then dic.Add iKey2, Array(0, ",")
    arr = dic.Item(iKey2)
    iKey = sArr(i, 2) & "#" & sArr(i, 1)
    If Not dic.exists(iKey) Then
      dic.Add iKey, i
      sArr(i, 4) = sArr(i, 1) & "[" & sArr(i, 3) & "]"
      arr(0) = arr(0) + 1
      arr(1) = arr(1) & sArr(i, 4) & ","
    Else
      ik = dic.Item(iKey)
      sArr(ik, 3) = sArr(i, 3) + sArr(ik, 3)
      tmp = sArr(i, 1) & "[" & sArr(ik, 3) & "]"
      arr(1) = Replace(arr(1), "," & sArr(ik, 4) & ",", "," & tmp & ",")
      sArr(ik, 4) = tmp
    End If
    dic.Item(iKey2) = arr
  Next i
  sRow = UBound(aCV)
  ReDim Res(1 To sRow, 1 To 2)
  For i = 1 To sRow
    iKey2 = aCV(i, 1)
    If dic.exists(iKey2) Then
      arr = dic.Item(iKey2)
      Res(i, 1) = arr(0)
      Res(i, 2) = Mid(arr(1), 2, Len(arr(1)) - 2)
    End If
  Next i
  Sheets("TK").Range("H2").Resize(sRow, 2) = Res
End Sub

Xin cảm ơn bạn đã giúp đỡ, mình chạy code này thấy khớp với kết quả code của bài 16 rồi.