Sắp xếp lại thứ tự hàng sang cột theo một trật tự đã định

[bin.vcsc]

Gửi anh chị

Mình đã dùng record macro để sắp xếp lại thứ tự từ hàng sang cột, nhưng chỉ mới chạy được 2 dòng, nếu số lượng dòng nhiều thì mình phải điều chỉnh lại như thế nào.
Mong anh chị và các bạn hỗ trợ giúp ah.

 

[Nhattanktnn]

Gửi anh chị

Mình đã dùng record macro để sắp xếp lại thứ tự từ hàng sang cột, nhưng chỉ mới chạy được 2 dòng, nếu số lượng dòng nhiều thì mình phải điều chỉnh lại như thế nào.
Mong anh chị và các bạn hỗ trợ giúp ah.

Thử:

Sub ghepcau()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, L As Long
Const Col As Byte = 3
Application.ScreenUpdating = False
With Sheets("Sheet1")
    If .Range("A1").CurrentRegion.Rows.Count = 1 Then Exit Sub
        sArr = .Range("A1").CurrentRegion.Value
        ReDim dArr(1 To (UBound(sArr, 1) - 1) * Col, 1 To 1)
        For I = 2 To UBound(sArr, 1)
            For K = Col To 1 Step -1
                L = L + 1
                dArr(L, 1) = sArr(I, K)
            Next
        Next
End With
Sheets("Output").Range("A2:A100000").ClearContents
Sheets("Output").Range("A2").Resize(L) = dArr
Application.ScreenUpdating = True
End Sub

 

[bin.vcsc]

Thử:

Sub ghepcau()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, L As Long
Const Col As Byte = 3
Application.ScreenUpdating = False
With Sheets("Sheet1")
    If .Range("A1").CurrentRegion.Rows.Count = 1 Then Exit Sub
        sArr = .Range("A1").CurrentRegion.Value
        ReDim dArr(1 To (UBound(sArr, 1) - 1) * Col, 1 To 1)
        For I = 2 To UBound(sArr, 1)
            For K = Col To 1 Step -1
                L = L + 1
                dArr(L, 1) = sArr(I, K)
            Next
        Next
End With
Sheets("Output").Range("A2:A100000").ClearContents
Sheets("Output").Range("A2").Resize(L) = dArr
Application.ScreenUpdating = True
End Sub

Cám ơn bạn @Nhattanktnn rất nhiều. Code bạn cho mình chạy ra đúng nhu cầu của mình rồi. Cám ơn bạn rất nhiều.