Nhờ giúp đỡ code đổi vị trí dữ liệu

[Eric.Shen]

Chào các bác,
Em đang có một bài toán như sau ạ:
Em có một cột dữ liệu, em muốn thêm một cột bên cạnh với điều kiện
Các dữ liệu tại ô lẻ (1,3,5,7...) sẽ thay cho các ô chẵn theo từng cặp với nhau và ngược lại
Nhờ các bác viết giúp em một đoạn code để xử lý với ạ
Cụ thể em để trong tệp đính kèm
Em cảm ơn các bác ạ

 

[BuiQuangThuan]

Chào các bác,
Em đang có một bài toán như sau ạ:
Em có một cột dữ liệu, em muốn thêm một cột bên cạnh với điều kiện
Các dữ liệu tại ô lẻ (1,3,5,7...) sẽ thay cho các ô chẵn theo từng cặp với nhau và ngược lại
Nhờ các bác viết giúp em một đoạn code để xử lý với ạ
Cụ thể em để trong tệp đính kèm
Em cảm ơn các bác ạ

Bạn có thể chụp 1 tấm hình kết quả mong muốn và dữ liệu được không

 

[Eric.Shen]

Bạn có thể chụp 1 tấm hình kết quả mong muốn và dữ liệu được không

Em gửi bác ạm, em muốn từ bảng 1 thành bảng 2 ạ

 

[SA_DQ]

Bạn chủ bài đăng thử với cái ni:

Sub ChuyenVi1_2()
 Dim Rws As Long, J As Long, Tmp

 Rws = 1 + [A7].CurrentRegion.Rows.Count
 ReDim Arr(1 To Rws, 1 To 1)
 For J = 2 To Rws Step 2
    Arr(J - 1, 1) = Cells(J + 1, "A").Value
    Arr(J, 1) = Cells(J, "A").Value
 Next J
 [F2].Resize(Rws).Value = Arr()
End Sub

 

[BuiQuangThuan]

Em gửi bác ạm, em muốn từ bảng 1 thành bảng 2 ạ

Thêm cách khác tham khảo

Sub ABC()
Dim sArr(), i&, Res(), S
    With Sheets("Sheet1")
        sArr = .Range("A2:A" & .Range("A" & Rows.Count).End(3).Row + 1).Value
        ReDim Res(1 To UBound(sArr), 1 To 2)
        For i = 1 To UBound(sArr) - 1 Step 2
            S = Split(i & "|" & i + 1, "|")
            Res(i, 1) = sArr(i, 1)
            Res(i + 1, 1) = sArr(i + 1, 1)
            Res(i, 2) = sArr(S(1), 1)
            Res(i + 1, 2) = sArr(S(0), 1)
        Next
        .Range("F2").Resize(UBound(sArr), 2).Value = Res
    End With
End Sub

 

[Eric.Shen]

Bạn chủ bài đăng thử với cái ni:

Sub ChuyenVi1_2()
 Dim Rws As Long, J As Long, Tmp

 Rws = 1 + [A7].CurrentRegion.Rows.Count
 ReDim Arr(1 To Rws, 1 To 1)
 For J = 2 To Rws Step 2
    Arr(J - 1, 1) = Cells(J + 1, "A").Value
    Arr(J, 1) = Cells(J, "A").Value
 Next J
 [F2].Resize(Rws).Value = Arr()
End Sub

Đúng kết quả rồi bác ạ,
Em cảm ơn bác nhiều ạ

Bài đã được tự động gộp: 7/10/23

Thêm cách khác tham khảo

Sub ABC()
Dim sArr(), i&, Res(), S
    With Sheets("Sheet1")
        sArr = .Range("A2:A" & .Range("A" & Rows.Count).End(3).Row + 1).Value
        ReDim Res(1 To UBound(sArr), 1 To 2)
        For i = 1 To UBound(sArr) - 1 Step 2
            S = Split(i & "|" & i + 1, "|")
            Res(i, 1) = sArr(i, 1)
            Res(i + 1, 1) = sArr(i + 1, 1)
            Res(i, 2) = sArr(S(1), 1)
            Res(i + 1, 2) = sArr(S(0), 1)
        Next
        .Range("F2").Resize(UBound(sArr), 2).Value = Res
    End With
End Sub

Em cảm ơn bác nhiều ạ