Chuyển data từ 1 cột về các dòng tương ứng

[trodoi123]

Dear các anh chị và các bạn

Hiện tại mình đang gặp khó khăn khi data được xuất từ web có tới hàng ngàn cửa hàng trăm ngàn dòng và hàng trăm cột
nhưng mỗi 1 cửa hàng lại có các dòng khác chứ không gom về 1 dòng để có thể kiểm tra dữ liệu dễ dàng hơn.
Trong file đính kèm có sheet DATA xuất từ web về và sheet Convert là kết quả mong muốn.

Hiện tại đang phải làm thủ công mất rất nhiều thời gian.
Mong các anh chị em diễn đàn hổ trợ giúp, hoặc có phương pháp nào chuyển đổi dữ liệu nhanh chóng hơn hơn là copy rồi chuyển đổi
Xin cám ơn !

 

[HUONGHCKT]

Dear các anh chị và các bạn

Hiện tại mình đang gặp khó khăn khi data được xuất từ web có tới hàng ngàn cửa hàng trăm ngàn dòng và hàng trăm cột
nhưng mỗi 1 cửa hàng lại có các dòng khác chứ không gom về 1 dòng để có thể kiểm tra dữ liệu dễ dàng hơn.
Trong file đính kèm có sheet DATA xuất từ web về và sheet Convert là kết quả mong muốn.

Hiện tại đang phải làm thủ công mất rất nhiều thời gian.
Mong các anh chị em diễn đàn hổ trợ giúp, hoặc có phương pháp nào chuyển đổi dữ liệu nhanh chóng hơn hơn là copy rồi chuyển đổi
Xin cám ơn !

View attachment 281445

View attachment 281447

KHUYÊN BẠN: Lần sau, KHÔNG nên thêm các từ ngữ nước ngoài vào bài viết (xăng pha nhớt) nếu muốn nhận được nhiều người giúp đỡ.
Xem file. nhấn vào mặt cười để xem và kiểm tra kết quả.

 

[trodoi123]

Cám ơn chế hay quá, tại quen môi trường để rút kinh nghiệm, hay quá chế ơi.

 

[BuiQuangThuan]

Thêm cách khác tham khảo coi sao
Chạy code:

Sub ABC()
    Dim Arr(), Res(), S, i&, j&, Temp&, K&, Dic As Object, Key
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("Data")
        Arr = .Range("A2:C" & .Range("A" & Rows.Count).End(3).Row).Value
    End With
    ReDim Res(1 To UBound(Arr), 1 To 1000)
    For i = 1 To UBound(Arr)
        Dic(Arr(i, 1)) = Dic(Arr(i, 1)) & "," & i
    Next i
    For Each Key In Dic.keys
        S = Split(Dic(Key), ",")
        If Temp > UBound(S) Then Temp = Temp Else Temp = UBound(S)
        K = K + 1
        Res(K, 1) = Key
        For j = 1 To UBound(S)
            Res(K, j + 1) = Arr(CLng(S(j)), 3)
        Next
    Next
    With Sheets("Convert")
        .Range("B2").Resize(1000000, 10000).ClearContents
        .Range("B2").Resize(Dic.Count, Temp + 1) = Res
    End With
End Sub