Cần giúp đỡ về code vba chuyển data từ 1 ô chứa nhiều dữ liệu sang từng mục đơn lẻ

[fukuchan]

Chào mọi người, mình có 1 file excel như tài liệu đính kèm. Mình muốn chuyển đổi nội dung từ sheet Data sang sheet Input theo từng mục tương ứng nhưng do có nhiều giá trị trong cùng 1 ô dữ liệu nên mình không biết sử dụng code vba như thế nào. Mong các bạn giúp đỡ.
Vì lần đầu mình đăng bài nên nếu có sai sót về nội dung hoặc sai vị trí đăng bài thì mong mọi người bỏ qua ^^

 

[Phuocam]

Chào mọi người, mình có 1 file excel như tài liệu đính kèm. Mình muốn chuyển đổi nội dung từ sheet Data sang sheet Input theo từng mục tương ứng nhưng do có nhiều giá trị trong cùng 1 ô dữ liệu nên mình không biết sử dụng code vba như thế nào. Mong các bạn giúp đỡ.
Vì lần đầu mình đăng bài nên nếu có sai sót về nội dung hoặc sai vị trí đăng bài thì mong mọi người bỏ qua ^^

Sau khi chạy code, sheets input sẽ như thế nào?

 

[fukuchan]

Sau khi chạy code, sheets input sẽ như thế nào?

Mình nghĩ mình muốn file input sau khi chạy sẽ hiển thị được các nội dung tương ứng như dưới ạ

 

[Phuocam]

Đầu vào 1,15 tỷ sao đầu ra còn 1,15 ?
Đầu vào 45m2 sao đầu ra còn 45 ?

 

[fukuchan]

Đầu vào 1,15 tỷ sao đầu ra còn 1,15 ?
Đầu vào 45m2 sao đầu ra còn 45 ?

Sorry mình ghi thiếu . Đúng như bạn hiểu, Data nguồn là 1,15 tỷ nên data tại mục input cũng là 1,15 tỷ nha

 

[Phuocam]

Thử:

Public Sub Test()
Dim i, lr, k As Long
Dim a, b
With Sheets("data")
    lr = .Range("D" & .Rows.Count).End(xlUp).Row
    If lr < 5 Then Exit Sub
    a = .Range("A5:E" & lr).Value   
End With
    ReDim b(1 To lr \ 4, 1 To 7)
    lr = lr - 5
    For i = 1 To lr Step 4
        k = k + 1
        b(k, 1) = a(i, 1)
        b(k, 2) = a(i, 4)
        b(k, 3) = a(i + 2, 4)
        b(k, 4) = a(i + 1, 4)
        b(k, 5) = a(i + 2, 3)
        b(k, 6) = a(i + 3, 4)
        b(k, 7) = a(i, 5)
    Next
Sheets("input").Range("A2").Resize(k, 7) = b
   
End Sub

 

[hoangtuaotrang_hp_vn]

Không biết code vba nên xài tạm hàm nhé!

Thứ tự các cột từ trái qua phải.

=ROW()-1

bác ơi, cột STT, xử lý thế nào để ẩn đi STT nếu những cột kia không có dữ liệu (dù vẫn có công thức)

 

[fukuchan]

Thử:

Public Sub Test()
Dim i, lr, k As Long
Dim a, b
With Sheets("data")
    lr = .Range("D" & .Rows.Count).End(xlUp).Row
    If lr < 5 Then Exit Sub
    a = .Range("A5:E" & lr).Value  
End With
    ReDim b(1 To lr \ 4, 1 To 7)
    lr = lr - 5
    For i = 1 To lr Step 4
        k = k + 1
        b(k, 1) = a(i, 1)
        b(k, 2) = a(i, 4)
        b(k, 3) = a(i + 2, 4)
        b(k, 4) = a(i + 1, 4)
        b(k, 5) = a(i + 2, 3)
        b(k, 6) = a(i + 3, 4)
        b(k, 7) = a(i, 5)
    Next
Sheets("input").Range("A2").Resize(k, 7) = b
  
End Sub

cảm ơn bạn rất nhiều, đúng ý của mình rồi ạ