chuyển đổi bằng cách nào, đề nghị giúp đỡ (1 người xem)

[mrhua]

chuyển đổi và tách các thành phần trong 1 cell , tôi gửi file đính kèm mong đc giúp đỡ

 

[Quang_Hải]

Không ai lại đi trộn gạo và nếp lại rồi ngồi xuống lựa trừ khi có đàn chim sẻ trong chuyện cổ tích

Thôi cũng làm tạm cho bạn nếu vì yêu công việc. Nếu bạn muốn rút gọn code lại thì chịu khó sửa gom code lại nhé

 

[concogia]

chuyển đổi và tách các thành phần trong 1 cell , tôi gửi file đính kèm mong đc giúp đỡ

Nếu dữ liệu đúng như trong bài thì "chơi" code này:

Public Sub NgoWaXa()
    Dim Vung, Tach, I, J, d, Cll, TachTiep
    Set d = CreateObject("scripting.dictionary")
    Vung = Range([B1], [B10000].End(xlUp))
        For Each Cll In Vung
            Cll = Replace(Cll, ":", ",")
            Tach = Split(Cll, ";")
                For I = LBound(Tach) To UBound(Tach)
                    TachTiep = Split(Tach(I), ",")
                        For J = LBound(TachTiep) To UBound(TachTiep) - 1
                            If Not d.exists(TachTiep(J)) Then
                                d.Add TachTiep(J), Val(TachTiep(UBound(TachTiep)))
                            Else
                                d.Item(TachTiep(J)) = d.Item(TachTiep(J)) + Val(TachTiep(UBound(TachTiep)))
                            End If
                        Next J
                Next I
        Next Cll
    [G6:H1000].ClearContents
    [G6].Resize(d.Count) = Application.WorksheetFunction.Transpose(d.keys)
    [H6].Resize(d.Count) = Application.WorksheetFunction.Transpose(d.items)
End Sub

Thân

 

[mrhua]

Cảm ơn các bạn đã giúp giải quyết vấn đề, it s done, perfect. nghe yêu cần giúp đỡ của em các anh thấy thật ngu ngốc nhưng không phải thế đâu, sự giúp đỡ của các bạn làm tôi có mấy trục triệu đấy , cái nút cám ơn nó không thể thể hiện lòng biết ơn của em với các anh. thank