Sắp xếp lại bảng dữ liệu

[kientung]

Em chào các anh, chị, chú trong diễn đàn.
Em có một bảng dữ liệu ban đầu theo như hình dưới và muốn sắp xếp lại giống như bảng dữ liệu sau khi chuyển đổi.
Mong được sự giúp đỡ của các anh, chị, chú.

 

[BuiQuangThuan]

Em chào các anh, chị, chú trong diễn đàn.
Em có một bảng dữ liệu ban đầu theo như hình dưới và muốn sắp xếp lại giống như bảng dữ liệu sau khi chuyển đổi.
Mong được sự giúp đỡ của các anh, chị, chú.

Tự căn chỉnh lại vùng dữ liệu ban đầu và vùng kết quả

Sub ABC()
    Dim sArr(), Res(), i&, j&, K&
    With Sheets("sheet1")
        sArr = .Range("C3:F5").Value
        ReDim Res(1 To UBound(sArr) * 3 * (UBound(sArr, 2) - 2), 1 To 2)
        For i = 1 To UBound(sArr)
            For j = 3 To 4
                K = K + 1
                Res(K, 1) = sArr(i, 1)
                Res(K + 1, 1) = sArr(i, 2)
                Res(K, 2) = sArr(i, j)
                Res(K + 1, 2) = sArr(i, j)
                K = K + 2
            Next
        Next
        .Range("F8").Resize(K, 2).Value = Res
    End With
End Sub

 

[kientung]

Tự căn chỉnh lại vùng dữ liệu ban đầu và vùng kết quả

Sub ABC()
    Dim sArr(), Res(), i&, j&, K&
    With Sheets("sheet1")
        sArr = .Range("C3:F5").Value
        ReDim Res(1 To UBound(sArr) * 3 * (UBound(sArr, 2) - 2), 1 To 2)
        For i = 1 To UBound(sArr)
            For j = 3 To 4
                K = K + 1
                Res(K, 1) = sArr(i, 1)
                Res(K + 1, 1) = sArr(i, 2)
                Res(K, 2) = sArr(i, j)
                Res(K + 1, 2) = sArr(i, j)
                K = K + 2
            Next
        Next
        .Range("F8").Resize(K, 2).Value = Res
    End With
End Sub

Em cảm ơn anh nhiều.