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

Cô gái 1m52 · 1/10/20

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.

Nhattanktnn · 2/10/20

excel_lv1.5 đã viết:
Bạn vô Power pivot-Data model (Manage) là thấy chi tiết
View attachment 246535

Office 2010 em cài thêm power pivot mà không thấy hàm concatenatex

Rồi cũng không thấy mục Data Model luôn

Ba mười ba · 2/10/20

snow25 đã viết:
For i = 1 To UBound(arr)
...
Next i
For i = 1 To UBound(arr)
...
Next i

Có thể rút bớt 1 for được không bạn?

snow25 · 2/10/20

Ba mười ba đã viết:
Có thể rút bớt 1 for được không bạn?

Mình không rút gọn được.Bạn rút gọn được không đăng lên cho mình tham khảo cái.

excel_lv1.5 · 2/10/20

Nhattanktnn đã viết:
Office 2010 em cài thêm power pivot mà không thấy hàm concatenatex
View attachment 246537
Rồi cũng không thấy mục Data Model luôn
View attachment 246539

Chắc là power pivot phiên bản cũ nó không có hàm đó, bạn thử xem trên máy nào có phiên bản office cao hơn thử xem.

Nhattanktnn · 2/10/20

excel_lv1.5 đã viết:
Chắc là power pivot phiên bản cũ nó không có hàm đó, bạn thử xem trên máy nào có phiên bản office cao hơn thử xem.

Vâng bác, để em về cài trên máy ở nhà xem sao. Em cũng muốn biết thêm cái này chứ đi làm office cũ nên ít khi được tiếp cận

Ba mười ba · 2/10/20

snow25 đã viết:
Mình không rút gọn được.Bạn rút gọn được không đăng lên cho mình tham khảo cái.

Mình cũng thế, mình còn không làm được như bạn nên mình mới hỏi.

tigertiger · 2/10/20

Ba mười ba đã viết:
Mình cũng thế, mình còn không làm được như bạn nên mình mới hỏi.

Tôi thì không hiểu đề bài muốn gì, để mà rút gọn

Cô gái 1m52 · 4/10/20

snow25 đã viết:

Thế nó bằng 1 rồi còn ra gì nữa.Ở trên cũng như vậy không thì sửa code như sau.

Mã:

Sub congviec()
    Dim i As Long, lr As Long, dic As Object, a As Long, dk As String, dks As String, b As Long, arr, kq, s As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("TK")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:C" & lr).Value
         ReDim Preserve arr(1 To UBound(arr), 1 To 4)
         For i = 1 To UBound(arr)
             dk = arr(i, 2) & "#" & arr(i, 1)
             If Not dic.exists(dk) Then
                dic.Add dk, i
                arr(i, 4) = arr(i, 3)
             Else
                b = dic.Item(dk)
                arr(b, 4) = arr(i, 3) + arr(b, 4)
             End If
         Next i
        For i = 1 To UBound(arr)
            dk = arr(i, 2)
            If Not dic.exists(dk) Then
                s = arr(i, 1) & "[" & arr(i, 4) & "]"
                dic.Add dk, Array(1, s)
            Else
                a = dic.Item(dk)(0)
                s = dic.Item(dk)(1)
                If arr(i, 4) > 0 Then
                    a = a + 1
                    s = s & "," & arr(i, 1) & "[" & arr(i, 4) & "]"
               End If
               dic.Item(dk) = Array(a, s)
           End If
       Next i
           lr = .Range("E" & Rows.Count).End(xlUp).Row
           If lr > 1 Then .Range("F2:G" & lr).ClearContents
           kq = .Range("E2:G" & lr).Value
           For i = 1 To UBound(kq)
               dk = kq(i, 1)
               If dic.exists(dk) Then
                  kq(i, 2) = dic.Item(dk)(0)
                  kq(i, 3) = dic.Item(dk)(1)
               End If
          Next i
            .Range("E2:G" & lr).Value = kq
   End With
End Sub

Tôi thử code trên của bạn đã ok, cảm ơn bạn

Ba Tê đã viết:
Bạn dùng Function cho "chủ động". Muốn kết quả tới đâu thì Copy công thức xuống đến đó.
---------------------------------
"Má ơi"
Làm xong lại thấy bài #12.

Hihi, cảm ơn bạn nhiều do nhu cầu công việc nên tôi muốn sửa đổi bổ sung cho rõ ràng hơn.

Bài đã được tự động gộp: 4/10/20

tigertiger đã viết:
Tôi thì không hiểu đề bài muốn gì, để mà rút gọn

Bạn không hiểu chỗ nào vậy, để tôi giải thích thêm ạ?

HieuCD · 4/10/20

Cô gái 1m52 đã viết:
Cảm ơn các bạn đã giúp đỡ tôi, code trên của bạn đúng với những gì tôi cần.
Do nhu cầu báo cáo rõ ràng nên tôi cần bổ sung thêm cột điểm (cột c)
Làm phiền bạn và mọi người giúp đỡ tôi thêm số điểm tổng hợp ứng với từng mã Nhân viên như ở cột G với ạ.
Với hình ảnh đính kèm bên dưới tôi đang ví dụ minh họa cho 2 trường hợp tại CV01: NV0001[23];NV0002[20];
View attachment 246493

Chạy code

Mã:

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
      If sArr(i, 3) = 1 Then sArr(i, 4) = sArr(i, 1) Else 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)
      If sArr(ik, 3) = 1 Then tmp = sArr(i, 1) Else 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("F2").Resize(sRow, 2) = Res
End Sub

Cô gái 1m52 · 4/10/20

HieuCD đã viết:

Chạy code

Mã:

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
      If sArr(i, 3) = 1 Then sArr(i, 4) = sArr(i, 1) Else 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)
      If sArr(ik, 3) = 1 Then tmp = sArr(i, 1) Else 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("F2").Resize(sRow, 2) = Res
End Sub

Cảm ơn bạn rất nhiều, tôi thử code, kết quả không lấy lấy được những số lượng =1 giống như bài 17 bạn xem giúp ạ.

HieuCD · 4/10/20

Cô gái 1m52 đã viết:
Cảm ơn bạn rất nhiều, tôi thử code, kết quả không lấy lấy được những số lượng =1 giống như bài 17 bạn xem giúp ạ.

2 code kết quả giống i sì mờ

Cô gái 1m52 · 4/10/20

HieuCD đã viết:
2 code kết quả giống i sì mờ

Mình chạy thử có thấy khác phần số điểm là 1 mà bạn.

ptm0412 · 4/10/20

excel_lv1.5 đã viết:
Nếu đã dùng power pivot thì nên để source gốc trong Data model rồi dùng Dax xử lý, chứ bạn dùng PQ xử lý thì nó trả về cho 1 trường hợp riêng lẽ, thống kê cho các trường hợp khác thì lại phải tạo source khác từ source gốc rất bất tiện, bạn xem thử!

Nếu dùng Power pivot không qua trung gian Power query sao bạn không nhấn nút Add to Data Model ngay trên Ribbon luôn?

Nhattanktnn đã viết:
Rồi cũng không thấy mục Data Model luôn

Office 2010 là Create linked table

Cu Tồ · 4/10/20

HieuCD đã viết:

Chạy code

Mã:

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
      If sArr(i, 3) = 1 Then sArr(i, 4) = sArr(i, 1) Else 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)
      If sArr(ik, 3) = 1 Then tmp = sArr(i, 1) Else 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("F2").Resize(sRow, 2) = Res
End Sub

Chào Bác em mới học vba,Có thắc mắc mong Bác giải thích cho.Em thấy các Bác khai bảo biến Dim sRow&, i&, k&, ik&, iKey$, iKey2$, tmp$ có thêm & , $ vậy Bác cho hỏi là các ký tự này có ý nghĩa,chức năng gì đặc biệt trong code không hay là để dễ phân biệt các biến ạ?

excel_lv1.5 · 4/10/20

ptm0412 đã viết:
Nếu dùng Power pivot không qua trung gian Power query sao bạn không nhấn nút Add to Data Model ngay trên Ribbon luôn?

View attachment 246731

Office 2010 là Create linked table

View attachment 246732

Lúc trước tôi thường connect trực tiếp từ data model, nhưng connect trực tiếp vậy có nhiều hạn chế, không append, merged, dynamic query.... được nên tôi chuyển sang connect bằng PQ trước sau đó mới add vào data model, sau này làm nhiều rồi quen mặc dù không có edit gì.

HieuCD · 4/10/20

Cu Tồ đã viết:
Chào Bác em mới học vba,Có thắc mắc mong Bác giải thích cho.Em thấy các Bác khai bảo biến Dim sRow&, i&, k&, ik&, iKey$, iKey2$, tmp$ có thêm & , $ vậy Bác cho hỏi là các ký tự này có ý nghĩa,chức năng gì đặc biệt trong code không hay là để dễ phân biệt các biến ạ?

Mục đích giảm số ký tự khai báo
& long
$ string
# double
% hình như là interge

Bài đã được tự động gộp: 4/10/20

Cô gái 1m52 đã viết:
Mình chạy thử có thấy khác phần số điểm là 1 mà bạn.

Thử file nào ?

Cu Tồ · 4/10/20

HieuCD đã viết:
Mục đích giảm số ký tự khai báo
& long
$ string
# double
% hình như là interge

Vậy là nó đại diện cho các kiểu dữ liểu biến ( as long , as string , as double , as interge ) hả Bác. Cảm ơn bác nhiều nha

Cô gái 1m52 · 5/10/20

HieuCD đã viết:
Mục đích giảm số ký tự khai báo
& long
$ string
# double
% hình như là interge

Bài đã được tự động gộp: 4/10/20

Thử file nào ?

Chào bạn HieuCD
Mình thử file bài 12,chạy code bài 18 kết quả như sau (lấy được số điểm là 1) với công việc là CV10 :
NV0038[1],NV0041[1],NV0043[1],NV0045[1],NV0046[0.5],...
Còn code của bạn như sau (không lấy được số điểm là 1 với công việc là CV10:
NV0038,NV0041,NV0043,NV0045,NV0046[0.5],...

HieuCD · 5/10/20

Cô gái 1m52 đã viết:
Chào bạn HieuCD
Mình thử file bài 12,chạy code bài 18 kết quả như sau (lấy được số điểm là 1) với công việc là CV10 :
NV0038[1],NV0041[1],NV0043[1],NV0045[1],NV0046[0.5],...
Còn code của bạn như sau (không lấy được số điểm là 1 với công việc là CV10:
NV0038,NV0041,NV0043,NV0045,NV0046[0.5],...

Xem công thức kiểm tra trong file

Cô gái 1m52 · 5/10/20

HieuCD đã viết:
Xem công thức kiểm tra trong file

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.

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

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên chính thức

Thành viên gạo cội

Thành viên tích cực

Thành viên gắn bó

Thành viên chính thức

Coming back ...

Thành viên mới

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

Thành viên mới

Bad Excel Member

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

Thành viên tích cực

Chuyên gia GPE

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

Thành viên mới

Chuyên gia GPE

File đính kèm

Thành viên mới