Code chuyển dữ liệu hàng sang cột (1 người xem)

[minhtuan55]

Mình có 1 bảng dữ liệu gồm 50 hàng 4 cột. Mình muốn chuyển sang dạng cột hết, trước giờ mình toàn làm thù công, nay nhờ các Cao thủ giúp mình để công việc của mình xữ lý được Nhanh hơn
Chi tiết em có ghi rõ trong File rất mong mọi người giúp đở. Xin chân thành càm ơn

 

[giaiphap]

Bạn thử đoạn code này thử xem được không nhé.

Sub Click_Me()
Dim Arr, Arrs(), i As Integer
 Arr = Range("B4:E" & Range("E65000").End(xlUp).Row).Value
ReDim Arrs(1 To UBound(Arr, 1) * 3, 1 To 1)
For i = LBound(Arr, 1) To UBound(Arr, 1)
    Arrs((i - 1) * 3 + 1, 1) = Arr(i, 1) & " * " & Arr(i, 2)
    Arrs((i - 1) * 3 + 2, 1) = Arr(i, 3)
    Arrs((i - 1) * 3 + 3, 1) = Arr(i, 4)
Next i
Range("I3").Resize(UBound(Arr, 1) * 3, 1).Value = Arrs
End Sub

 

[minhtuan55]

Bạn thử đoạn code này thử xem được không nhé.

Sub Click_Me()
Dim Arr, Arrs(), i As Integer
 Arr = Range("B4:E" & Range("E65000").End(xlUp).Row).Value
ReDim Arrs(1 To UBound(Arr, 1) * 3, 1 To 1)
For i = LBound(Arr, 1) To UBound(Arr, 1)
    Arrs((i - 1) * 3 + 1, 1) = Arr(i, 1) & " * " & Arr(i, 2)
    Arrs((i - 1) * 3 + 2, 1) = Arr(i, 3)
    Arrs((i - 1) * 3 + 3, 1) = Arr(i, 4)
Next i
Range("I3").Resize(UBound(Arr, 1) * 3, 1).Value = Arrs
End Sub

COde anh đúng 90% rồi, còn 1 chút nữa là Ok. Anh sửa lại giúp em chổ
Arr = Range("B4:E" & Range("E65000").End(xlUp).Row).Value
Vì dữ liệu em bên dưới có nữa nên em sợ nó bắt sai nên em tự sửa lại chính xác vị trí dữ liệu là
Arr = Range("B4:E53").Value
Thì kết quả cũng đúng với những hàng có dữ liệu, còn hàng không có dữ liệu nó cứ ra dấu *. mong anh sửa lại nếu hàng nào có dữ liệu tên hàng thì xuất ra còn không có thì xuất ra trống luôn
Thank a

 

[PacificPR]

COde anh đúng 90% rồi, còn 1 chút nữa là Ok. Anh sửa lại giúp em chổ
Arr = Range("B4:E" & Range("E65000").End(xlUp).Row).Value
Vì dữ liệu em bên dưới có nữa nên em sợ nó bắt sai nên em tự sửa lại chính xác vị trí dữ liệu là
Arr = Range("B4:E53").Value
Thì kết quả cũng đúng với những hàng có dữ liệu, còn hàng không có dữ liệu nó cứ ra dấu *. mong anh sửa lại nếu hàng nào có dữ liệu tên hàng thì xuất ra còn không có thì xuất ra trống luôn
Thank a

Bạn thử thay lại thành như thế này xem sao (Nhập vùng theo tùy chọn)

Arr = Application.InputBox("Chon du lieu dua vao mang:", "Chon vung", Type:=8)

 

[minhtuan55]

Bạn thử thay lại thành như thế này xem sao (Nhập vùng theo tùy chọn)

Dạ cái này thì em biết rồi. em muốn cố định vùng dữ liệu Arr = Range("B4:E53").Value
Không phải hiện Hộp Input rồi chọn , quá mất thời gian luôn anh

 

[PacificPR]

Dạ cái này thì em biết rồi. em muốn cố định vùng dữ liệu Arr = Range("B4:E53").Value
Không phải hiện Hộp Input rồi chọn , quá mất thời gian luôn anh

Vậy bạn sửa lại như thế này thử xem sao

Arr = Range("B4:E" & Range("E53").End(xlUp).Row).Value

 

[giaiphap]

COde anh đúng 90% rồi, còn 1 chút nữa là Ok. Anh sửa lại giúp em chổ
Arr = Range("B4:E" & Range("E65000").End(xlUp).Row).Value
Vì dữ liệu em bên dưới có nữa nên em sợ nó bắt sai nên em tự sửa lại chính xác vị trí dữ liệu là
Arr = Range("B4:E53").Value
Thì kết quả cũng đúng với những hàng có dữ liệu, còn hàng không có dữ liệu nó cứ ra dấu *. mong anh sửa lại nếu hàng nào có dữ liệu tên hàng thì xuất ra còn không có thì xuất ra trống luôn
Thank a

Đưa file thật của bạn lên đây xem thử thế nào? chứ code mình viết cho file #1, còn bạn lấy code đó áp dụng cho file khác thì làm sao tôi biết thế nào mà giúp đây.

 

[minhtuan55]

Đưa file thật của bạn lên đây xem thử thế nào? chứ code mình viết cho file #1, còn bạn lấy code đó áp dụng cho file khác thì làm sao tôi biết thế nào mà giúp đây.

Dạ code anh e sửa lại ok rồi anh ạ. Em cảm ơn anh nhiều lắm