Thử code.
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
Set dic = CreateObject("scripting.dictionary")
With Sheets("TK")
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A2:B" & lr).Value
ReDim kq(1 To UBound(arr), 1 To 3)
For i = 1 To UBound(arr)
dk = arr(i, 2)
If Not dic.exists(dk) Then
a = a + 1
dic.Add dk, a
kq(a, 1) = arr(i, 2)
kq(a, 2) = 1
kq(a, 3) = arr(i, 1)
Else
b = dic.Item(dk)
dks = "," & arr(i, 1) & ","
If InStr(1, "," & kq(b, 3) & ",", dks) = 0 Then
kq(b, 3) = kq(b, 3) & "," & arr(i, 1)
kq(b, 2) = kq(b, 2) + 1
End If
End If
Next i
lr = .Range("E" & Rows.Count).End(xlUp).Row
If lr > 1 Then .Range("E2:G" & lr).ClearContents
If a Then .Range("e2:g2").Resize(a).Value = kq
End With
End SubCảm ơn bạn đã giúp đỡ, phiền bạn có thể sửa giúp cột công việc (cột E) để nhập tay được không, nghĩa là nhập tay công việc nào thì dữ liệu sẽ tìm kiếm và điền theo công việc đó, chứ không phải là liệt kê hết công việc ạ.
Cột F hàm COUNTIF
Bạn thử xem file
Bạn thử.
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, lr1
Set dic = CreateObject("scripting.dictionary")
With Sheets("TK")
lr = .Range("E" & Rows.Count).End(xlUp).Row
If lr < 1 Then Exit Sub
.Range("F2:G" & lr).ClearContents
kq = .Range("E2:G" & lr).Value
For i = 1 To UBound(kq)
dk = kq(i, 1)
dic.Item(dk) = i
Next i
lr1 = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A2:B" & lr1).Value
For i = 1 To UBound(arr)
dk = arr(i, 2)
If dic.exists(dk) Then
b = dic.Item(dk)
dks = "," & arr(i, 1) & ","
If kq(b, 3) = Empty Then
kq(b, 3) = arr(i, 1)
kq(b, 2) = 1
ElseIf InStr(1, "," & kq(b, 3) & ",", dks) = 0 Then
kq(b, 3) = kq(b, 3) & "," & arr(i, 1)
kq(b, 2) = kq(b, 2) + 1
End If
End If
Next i
.Range("e2:g" & lr).Value = kq
End With
End SubNế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ử!
Các hàm DAX mình chưa biết nhiều, chỉ biết 1 số hàm cơ bản nên mới phải dùng PQ để loại trùng. Trước giờ xử lý nối chuỗi loại trùng toàn phải dùng PQ, nay biết thêm hàm DISTINCT
Nên tìm hiểu bạn ạ, các hàm Dax tượng tự excel và dễ hơn excel, nhưng với những người rành về mảng excel sẽ khó tiếp cận hơn những người chưa biết excel vì có thể xem Dax là dynamic array, nhưng khi tiếp cận rồi thì nó hấp dẫn hơn excel, Dax là rễ của Power pivot và power BI nên nó sẽ mang lại rất nhiều lợi ích cho bạn trong công việc so với cách làm bây giờ.
Tiếp cận DAX thì nên tiếp cận theo hướng cơ sở dữ liệu, cụ thể các TABLE, FIELDs (Columns), hay RECORDs (Rows) - là phép tính với các đối tượng đó - nó tổng quan và trừu tượng hơn chút so với hàm excel chỉ đối với cell và range.
Dax xử lý custom table và custom column không có Custom Row và Cells, nhưng chỉ cần vậy là làm được hết nhưng phải rành về dynamic array điều kiện filter và hoàn cảnh filter, đôi khi không sử dụng hàm mảng nó vẫn biến đổi bởi vậy tôi mới nói những người rành về mảng bên excel qua Dax sẽ bị hố nếu vẫn giữ tư duy của mảng excel, Dax có thể xử lý mọi Case mà không cần dùng tới M trong PQ, chỉ có các trường hợp đệ quy mới cần dùng M nhưng nếu cần xử lý vậy thì làm ngay data gốc luôn chứ chẳng cần PQ xử lý
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.
Bạn dùng power pivot phiên bản năm bao nhiêu thế ạ
Tôi đang sài power pivot của office 365 bạn ạ
Bạn thử code này nhé.
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
If arr(i, 4) = 1 Then
s = arr(i, 1)
Else
s = arr(i, 1) & "[" & arr(i, 4) & "]"
End If
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
If arr(i, 4) = 1 Then
s = s & "," & arr(i, 1)
Else
s = s & "," & arr(i, 1) & "[" & arr(i, 4) & "]"
End If
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 SubCảm ơn bạn, tôi thử code trên thấy có mã NV không ra điểm số ví dụ: NV0038,NV0041,NV0043,NV0045, tại CV10.
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.
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
Bác có thể chỉ giúp làm thế nào để nối chuỗi vậy không? Em dùng office 2010, có tải power pivot về rồi nhưng đến đoạn nối chuỗi em chịu (em chưa dùng cái này bao giờ). File của bác thì phiên bản máy của em lại không mở chi tiết ra xem được
