Xin code để sắp xếp dữ liệu sang sheet mới có điều kiện (1 người xem)

[tuonglaigan]

Kính gửi Quý anh chị và các bạn!

Hiện mình đang có nhu cầu sắp xếp dữ liệu từ sheet gốc (sheet data) sang sheet mới (sheet sort) cho tiện việc sử dụng dữ liệu! Mình đã tìm hiểu nhiều trên diễn đàn và biết viết code VBA có thể giải quyết vấn đề này nên xin phép admin đăng một bài mới thảo luận chủ đề này cho các bạn cùng quan tâm và giúp đỡ.

Trong sheet data dữ liệu được sắp xếp theo dạng mỗi ngân hàng là 1 dòng cho tất cả các chỉ số trong giai đoạn 2000-2015, chính vì thế số lượng cột trong sheet data này lên tới 241 cột rất khó theo dõi.

Để tiện theo dõi và sử dụng dữ liệu mình mong muốn nhờ các bạn hỗ trợ code để chuyển dữ liệu từ sheet data sang sheet sort theo dạng: (i) mỗi chỉ tiêu là 1 cột; (ii) bank code và year sẽ nằm theo cột; (iii) dữ liệu của mỗi ngân hàng sẽ chạy hết trong 16 năm (2000-2015) rồi đến ngân hàng khác và cứ như vậy cho đủ 44 ngân hàng.

Mình xin gửi kèm file ví dụ đi kèm nhờ Quý anh chị và các bạn giúp đỡ!

Trân trọng cảm ơn và chúc diễn đàn mình đón tết bình an, hạnh phúc!

 

[dhn46]

Bạn dùng sub sau

Sub SapXep()
Dim Arr, Res
Dim i As Long, j As Long, c As Long, r As Long, t As Long
With Sheets("Data")
Arr = .Range("A1:IG" & .Range("A65536").End(3).Row)
End With
ReDim Res(1 To 10000, 1 To 18)
For i = 2 To UBound(Arr, 1)
    c = 0
    For j = 2 To UBound(Arr, 2) Step 16
        c = c + 1
        For t = 1 To 16
            Res(t + r * 16, 1) = Arr(i, 1)
            Res(t + r * 16, 2) = Right(Arr(1, j - 1 + t), 4)
            Res(t + r * 16, c + 2) = Arr(i, j - 1 + t)
        Next
    Next
    r = r + 1
Next
Sheet2.Range("A2").Resize(1000, 18) = Res
End Sub

 

[tuonglaigan]

Cảm ơn bạn dhn46 nhiều nhiều! Mình đã giải quyết xong, nhanh và gọn vấn đề của mình!
Nhưng dhn46 ơi cho mình hỏi xíu nữa với!
Đối với các bộ dữ liệu khác có cấu trúc tương tự chỉ khác về số cột (thay vì 241) mà có thể nhiều hơn thì khi sửa lại đoạn code mình cần phải chú ý đến các giá trị gì vậy?

Cảm ơn dhn46 nhiều, rất nhiều!

Bạn dùng sub sau

Sub SapXep()
Dim Arr, Res
Dim i As Long, j As Long, c As Long, r As Long, t As Long
With Sheets("Data")
Arr = .Range("A1:IG" & .Range("A65536").End(3).Row)
End With
ReDim Res(1 To 10000, 1 To 18)
For i = 2 To UBound(Arr, 1)
    c = 0
    For j = 2 To UBound(Arr, 2) Step 16
        c = c + 1
        For t = 1 To 16
            Res(t + r * 16, 1) = Arr(i, 1)
            Res(t + r * 16, 2) = Right(Arr(1, j - 1 + t), 4)
            Res(t + r * 16, c + 2) = Arr(i, j - 1 + t)
        Next
    Next
    r = r + 1
Next
Sheet2.Range("A2").Resize(1000, 18) = Res
End Sub

 

[dhn46]

Bạn thay đoạn

Arr = .Range("A1:IG" & .Range("A65536").End(3).Row)

bằng code sau

Arr = .Range("A1").Resize(.[A1].End(xlDown).Row, .[A1].End(xlToRight).Column)

'-------------------------------
Với điều kiện cột A là dữ liệu liên tục.

 

[tuonglaigan]

Cảm ơn bạn dhn46 nhiều nhiều!

Bạn thay đoạn

Arr = .Range("A1:IG" & .Range("A65536").End(3).Row)

bằng code sau

Arr = .Range("A1").Resize(.[A1].End(xlDown).Row, .[A1].End(xlToRight).Column)

'-------------------------------
Với điều kiện cột A là dữ liệu liên tục.

 

[tuonglaigan]

Bạn dhn46 và bạn hpkhuong ơi cho mình hỏi nữa là khi mình thay đổi số lượng các cột ngoài lưu ý về khai báo mảng:
Arr = .Range("A1").Resize(.[A1].End(xlDown).Row, .[A1].End(xlToRight).Column)

Thì dòng lệnh:
Sheet2.Range("A2").Resize(1000, 18) = Res
Không biết mình có phải thay đổi gì không? Mình không hiểu lắm con số 1000 và 18?

Nhờ hai bạn giải thích chi tiết giúp mình!

Cảm ơn hai bạn nhiều!

Bạn chú ý cái này là được. Tương ứng với cột có dữ liệu cuối cùng của bạn. Chính là cột IG trên sheet Data của bạn...nếu có nhiều hơn thì cứ thế ....rộng hơn ra là được.

Arr = .Range("A1:IG" & .Range("A65536").End(3).Row)