Tổng hợp mã Khách hàng

[Miccpro]

Em có bảng ghi ngày tháng theo biểu dọc gồm cột Ngày Tháng và Mã KH, em các anh chị giúp em tổng hợp các mã KH như cột C trong File đính kèm, em xin cảm ơn!

 

[Phuocam]

Em có bảng ghi ngày tháng theo biểu dọc gồm cột Ngày Tháng và Mã KH, em các anh chị giúp em tổng hợp các mã KH như cột C trong File đính kèm, em xin cảm ơn!

Bạn xem thử bài 16:

https://www.giaiphapexcel.com/diendan/threads/công-thức-dò-tìm-tham-chiếu-trong-chuỗi-ký-tự-cho-trước.137669/post-883140

 

[be_09]

Em có bảng ghi ngày tháng theo biểu dọc gồm cột Ngày Tháng và Mã KH, em các anh chị giúp em tổng hợp các mã KH như cột C trong File đính kèm, em xin cảm ơn!

Tôi thắc mắc mã khách hàng là duy nhất, tại sao gộp mã khách hàng khác nhau vào một Cell thì dựa vào tiêu chí nào?
Đừng có nói là gộp khách hàng trong một ngày vào một Cell là cách làm phi lý nhất tôi chưa từng thấy.

 

[Miccpro]

Tôi thắc mắc mã khách hàng là duy nhất, tại sao gộp mã khách hàng khác nhau vào một Cell thì dựa vào tiêu chí nào?
Đừng có nói là gộp khách hàng trong một ngày vào một Cell là cách làm phi lý nhất tôi chưa từng thấy.

Cái này em lấy ví dụ anh ạ. Bản chất là em muốn tổng hợp lại 1 Cells để xem những ngày nào có số Mã bằng và trùng nhau

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

Bạn xem thử bài 16:

https://www.giaiphapexcel.com/diendan/threads/công-thức-dò-tìm-tham-chiếu-trong-chuỗi-ký-tự-cho-trước.137669/post-883140

Cảm ơn anh đã quan tâm, em muốn giải quyết bài toán theo VBA ạ

 

[be_09]

Cái này em lấy ví dụ anh ạ. Bản chất là em muốn tổng hợp lại 1 Cells để xem những ngày nào có số Mã bằng và trùng nhau

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

Cảm ơn anh đã quan tâm, em muốn giải quyết bài toán theo VBA ạ

Giải thích tôi chưa hiểu, nhưng muốn tổng hợp thì sử dụng PivotTable.

 

[Phuocam]

Cảm ơn anh đã quan tâm, em muốn giải quyết bài toán theo VBA ạ

Thử:

Public Sub Test()
Dim lastRow As Long, i As Long
Dim sArr(), dArr
Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    sArr = Range("A4:B" & lastRow).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
        For i = 1 To UBound(sArr, 1)
        If Not dic.exists(sArr(i, 1)) Then
            dic.Add sArr(i, 1), i
            dArr(i, 1) = sArr(i, 2)
        Else
            dArr(dic.item(sArr(i, 1)), 1) = dArr(dic.item(sArr(i, 1)), 1) & ", " & sArr(i, 2)
        End If
        Next i
        Range("C4").Resize(i - 1, 1) = dArr
End Sub

 

[Miccpro]

Thử:

Public Sub Test()
Dim lastRow As Long, i As Long
Dim sArr(), dArr
Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    sArr = Range("A4:B" & lastRow).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
        For i = 1 To UBound(sArr, 1)
        If Not dic.exists(sArr(i, 1)) Then
            dic.Add sArr(i, 1), i
            dArr(i, 1) = sArr(i, 2)
        Else
            dArr(dic.item(sArr(i, 1)), 1) = dArr(dic.item(sArr(i, 1)), 1) & ", " & sArr(i, 2)
        End If
        Next i
        Range("C4").Resize(i - 1, 1) = dArr
End Sub

Đúng ý em rồi, cảm ơn anh

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

Thử:

Public Sub Test()
Dim lastRow As Long, i As Long
Dim sArr(), dArr
Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    sArr = Range("A4:B" & lastRow).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
        For i = 1 To UBound(sArr, 1)
        If Not dic.exists(sArr(i, 1)) Then
            dic.Add sArr(i, 1), i
            dArr(i, 1) = sArr(i, 2)
        Else
            dArr(dic.item(sArr(i, 1)), 1) = dArr(dic.item(sArr(i, 1)), 1) & ", " & sArr(i, 2)
        End If
        Next i
        Range("C4").Resize(i - 1, 1) = dArr
End Sub

Nhờ anh sửa lại xíu như file đính kèm được không ạ. Em thử nghịch mãi mà không xong

 

[Phuocam]

Nhờ anh sửa lại xíu như file đính kèm được không ạ. Em thử nghịch mãi mà không xong

Thử dùng 2 vòng For:

Public Sub Test2()
Dim lastRow As Long, i As Long
Dim sArr(), dArr
Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    sArr = Range("A4:B" & lastRow).Value
    lastRow = UBound(sArr, 1)
    ReDim dArr(1 To lastRow, 1 To 1)
        For i = 1 To lastRow
                 If Not dic.exists(sArr(i, 1)) Then
                             dic.Add sArr(i, 1), sArr(i, 2)
                 Else
                            dic.Item(sArr(i, 1)) = dic.Item(sArr(i, 1)) & ", " & sArr(i, 2)
                End If
        Next i
        For i = 1 To lastRow
                dArr(i, 1) = dic.Item(sArr(i, 1))
        Next
        Range("C4").Resize(i - 1, 1) = dArr
End Sub