Quản lý dữ liệu từ CỘT chuyển sang HÀNG (1 người xem)

[le_anh81]

Nhờ ACE giúp với.

Mình có dữ liệu như file đính kèm:
- Sheet "Data" thể hiện dữ liệu dạng CỘT
- Sheet "Final" thể hiện dữ liệu dạng HÀNG (trích xuất từ sheet "Data")

Nhờ ACE giúp xem có hàm gì, hay code VBA thế nào giúp mình với, để sheet "Final" có thể tự động chuyển sang dạng HÀNG.
Ngay cả khi sheet "Data" thêm dòng (thêm danh sách học sinh) thì dữ liệu bên sheet "Final" cũng tự động bổ sung thêm tên và điểm theo.

Xin cảm ơn ACE!

 

[♫ђöล♥ßล†♥†µ♫]

Nhờ ACE giúp với.

Mình có dữ liệu như file đính kèm:
- Sheet "Data" thể hiện dữ liệu dạng CỘT
- Sheet "Final" thể hiện dữ liệu dạng HÀNG (trích xuất từ sheet "Data")

Nhờ ACE giúp xem có hàm gì, hay code VBA thế nào giúp mình với, để sheet "Final" có thể tự động chuyển sang dạng HÀNG.
Ngay cả khi sheet "Data" thêm dòng (thêm danh sách học sinh) thì dữ liệu bên sheet "Final" cũng tự động bổ sung thêm tên và điểm theo.

Xin cảm ơn ACE!

Bạn thử Code này xem

Sub Data()
    Dim sArr, dArr, I As Long, J As Long, K As Long
With Sheets("Data")
    sArr = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr) * (UBound(sArr, 2) - 1), 1 To 3)
For I = 2 To UBound(sArr)
    For J = 2 To UBound(sArr, 2)
        If sArr(I, J) <> Empty Then
            K = K + 1
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(1, J)
            dArr(K, 3) = sArr(I, J)
        End If
    Next J
Next I
With Sheets("Final")
    .Range("B3").Resize(K, 3) = dArr
End With
End Sub

 

[le_anh81]

Đúng ý rồi, cảm ơn bạn ♫ђöล♥ßล†♥†µ♫ nhiều.

Bạn thử Code này xem

Sub Data()
    Dim sArr, dArr, I As Long, J As Long, K As Long
With Sheets("Data")
    sArr = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr) * (UBound(sArr, 2) - 1), 1 To 3)
For I = 2 To UBound(sArr)
    For J = 2 To UBound(sArr, 2)
        If sArr(I, J) <> Empty Then
            K = K + 1
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(1, J)
            dArr(K, 3) = sArr(I, J)
        End If
    Next J
Next I
With Sheets("Final")
    .Range("B3").Resize(K, 3) = dArr
End With
End Sub