Chuyển dữ liệu từ dạng tổng hợp sang dạng liệt kê (1 người xem)

[tvn_042]

Hi cả nhà,

Mình đang có một vấn đề đau đầu, nhờ mọi người ra tay hỗ trợ.
Hiện mình có file excel khoảng 4000 dòng có dữ liệu như cột A & B trong file đính kèm.
Mình cần chuyển dữ liệu sang liệt kê như cột E. Mình đang cần gấp, mọi người giúp nhé. Cám ơn rất nhiều!

 

[SA_DQ]

Chuyện này mình nghỉ chỉ nên làm nhờ 1 macro

Mình sẽ nêu ra đây 4 bước của 1 trong 3 giải thuật:

B1: (Trưng dụng cột 'A' đang trống của bạn); Ta gán chuỗi 'GPE' vô [A2] để làm tên trường;
Tại ô bên trái của ô cuối chứa dữ liệu của cột 'B' (Cụ thể trong ví dụ của bạn là [A8]) ta cũng tạm thời nhập chuỗi nêu trên

B2: Thiết lập vòng lặp duyệt toàn bộ các ô chưa dữ liệu của cột bắt đầu từ [B3]
Khi duyệt đến ô nào thì ta làm 3 động tác sau:

B2.1: Ghi vô ô bên trái liền kề chuỗi gồm "A" nối với trị của ô đang duyệt

B2.2: Xác định ô đầu tiên ngay dưới ô cuối có dữ liệu của cột 'A' & ta điền liên tiếp số ô xuống fía dười ô này đều có chuỗi gồm "A" nối với trị của ô đang duyệt & nối thêm tri của ô bên fài liền kề ô đang duyệt. Số ô được điền bằng số liệu trong ô bên fải trừ đi 1 (Vì ta đã điền 1 lần ở B2.1)

B2.3: Ta lại điền trị của ô đang duyệt vô các ô bên fài liền kề với các ơ vừa điền dữ liệu ở B2.2

B3: Xếp toàn bộ dữ liệu 3 cột theo cột 'A'

B4: Xóa dữ liệu cột 'A' (Chính xác hơn là làm rỗng dữ liệu cột 'A')

Dài dòng & khó hiểu fải vậy không? Nếu vậy bạn có thể chuyển sang nghiên cứu các dòng lệnh sau thực thi điều đó trong macro sau:

Option Explicit
Sub ThemDong()
 Dim Cls As Range, Rws As Long
 Const GPE As String = "GPE.COM"
 
  Rws = [B2].End(xlDown).Row
 1 [A2].Value = GPE:          Cells(Rws, "A").Value = GPE
 For Each Cls In Range([B3], [B3].End(xlDown))
21    Cls.Offset(, -1).Value = "A" & CStr(Cls.Value)
    With [A65500].End(xlUp).Offset(1).Resize(Cls.Offset(, 1).Value - 1)
22        .Value = "A" & CStr(Cls.Value) & Cls.Offset(, 1).Value
23        .Offset(, 1).Value = Cls.Value
    End With
 Next Cls
 Range("A2").CurrentRegion.Select
3 Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
4 Columns("A:A").Select
 Selection.ClearContents
End Sub