Giúp code chuyển dữ liệu dọc sang ngang (1 người xem)

[minhtuan55]

Chào cả nhà GPE !. Kính chúc cả nhà năm mới 2017 sức khỏe, làm ăn phát tài..
Hôm nay 30 tết ở nhà nấu Bánh tét mệt quá. giờ mới có thời gian rảnh lên nhờ cả nhà giúp mình chút xíu thôi
Mình có 1 bảng dữ liệu được bố trí theo cột ( gồm 50 tên hàng ). Giờ mình muốn chuyển thành sang hàng. Mọi người giúp code để mình nhé. Em xin chân thành cảm ơn
Em có gửi File mọi người xem giúp em nha.

 

[befaint]

Hai (02) cái bánh tét nhá? Mà dùng công thức được không? Khi số lượng =1 thì có ghi là hàng*1 hay không ghi (*1)?

Sub HangCot()
Dim z As Long, tmp As Variant, k As Long, KQ() As Variant, i As Long, T
z = Sheet1.Range("IV3").End(xlToLeft).Column
tmp = Sheet1.Range("B3").Resize(1, z - 1): z = UBound(tmp, 2)
ReDim KQ(1 To z / 3, 1 To 5)
For k = 1 To z - 2 Step 3
    T = tmp(1, k)
    If T <> Empty Then
        i = i + 1: KQ(i, 1) = i
        If InStr(T, "*") Then
            KQ(i, 2) = Split(T, "*")(0): KQ(i, 3) = Split(T, "*")(1)
        Else
            KQ(i, 2) = T: KQ(i, 3) = 1
        End If
        KQ(i, 4) = tmp(1, k + 1): KQ(i, 5) = KQ(i, 3) * KQ(i, 4)
    End If
Next k
Sheet1.Range("A10").Resize(1000, 5).ClearContents
Sheet1.Range("A10").Resize(i, 5) = KQ
End Sub

 

[Ba Tê]

Chào cả nhà GPE !. Kính chúc cả nhà năm mới 2017 sức khỏe, làm ăn phát tài..
Hôm nay 30 tết ở nhà nấu Bánh tét mệt quá. giờ mới có thời gian rảnh lên nhờ cả nhà giúp mình chút xíu thôi
Mình có 1 bảng dữ liệu được bố trí theo cột ( gồm 50 tên hàng ). Giờ mình muốn chuyển thành sang hàng. Mọi người giúp code để mình nhé. Em xin chân thành cảm ơn
Em có gửi File mọi người xem giúp em nha.

Dữ liệu ở đâu mà "quái chiêu" vậy "Chời"?
Mỗi nhóm 3 côt phải liên tục, không có kiểu "4,5,6.......> Đến 50" chen vào "lãng lãng".

Public Sub GPE()
Dim sArr(), dArr(), J As Long, K As Long, Tmp
sArr = Range("B2", Range("B2").End(xlToRight)).Resize(2).Value
ReDim dArr(1 To UBound(sArr, 2), 1 To 5)
For J = 1 To UBound(sArr, 2) Step 3
    If sArr(2, J) <> Empty Then
        K = K + 1: dArr(K, 1) = K
        Tmp = Split(sArr(2, J), "*")
        dArr(K, 2) = Tmp(0)
        If InStr(sArr(2, J), "*") Then dArr(K, 3) = Tmp(1)
        dArr(K, 4) = sArr(2, J + 1)
        dArr(K, 5) = sArr(2, J + 2)
    End If
Next J
Range("A10:E100").ClearContents
If K Then Range("A10:E10").Resize(K) = dArr
End Sub

 

[befaint]

Dữ liệu ở đâu mà "quái chiêu" vậy "Chời"?
Mỗi nhóm 3 côt phải liên tục, không có kiểu "4,5,6.......> Đến 50" chen vào "lãng lãng".

[COLOR=#0000ff]...
If InStr(sArr(2, J), "*") Then dArr(K, 3) = Tmp(1)[/COLOR]
...

ủa, em làm sao biết mà trả lời anh bây giờ?

"4,5,6.......> Đến 50" là bạn chủ thớt muốn diễn tả trường [Tên hàng * SL] tiếp theo cho tới tên hàng thứ 50.

 

[Ba Tê]

ủa, em làm sao biết mà trả lời anh bây giờ?

"4,5,6.......> Đến 50" là bạn chủ thớt muốn diễn tả trường [Tên hàng * SL] tiếp theo cho tới tên hàng thứ 50.

Xin lỗi "bồ" nhé. Tôi trích dẫn sai bài viết rồi. Đã sửa lại ở bài trên.

 

[Gió Đông]

Chào cả nhà GPE !. Kính chúc cả nhà năm mới 2017 sức khỏe, làm ăn phát tài..
Hôm nay 30 tết ở nhà nấu Bánh tét mệt quá. giờ mới có thời gian rảnh lên nhờ cả nhà giúp mình chút xíu thôi
Mình có 1 bảng dữ liệu được bố trí theo cột ( gồm 50 tên hàng ). Giờ mình muốn chuyển thành sang hàng. Mọi người giúp code để mình nhé. Em xin chân thành cảm ơn
Em có gửi File mọi người xem giúp em nha.

30 tết thì nghỉ đi, lên làm gì rui kêu không rảnh hoài?

 

[minhtuan55]

Hai (02) cái bánh tét nhá? Mà dùng công thức được không? Khi số lượng =1 thì có ghi là hàng*1 hay không ghi (*1)?

Sub HangCot()
Dim z As Long, tmp As Variant, k As Long, KQ() As Variant, i As Long, T
z = Sheet1.Range("IV3").End(xlToLeft).Column
tmp = Sheet1.Range("B3").Resize(1, z - 1): z = UBound(tmp, 2)
ReDim KQ(1 To z / 3, 1 To 5)
For k = 1 To z - 2 Step 3
    T = tmp(1, k)
    If T <> "" Then
        i = i + 1: KQ(i, 1) = i
        If InStr(T, "*") Then
            KQ(i, 2) = Split(T, "*")(0): KQ(i, 3) = Split(T, "*")(1)
        Else
            KQ(i, 2) = T: KQ(i, 3) = 1
        End If
        KQ(i, 4) = tmp(1, k + 1): KQ(i, 5) = KQ(i, 3) * KQ(i, 4)
    End If
Next k
Sheet1.Range("A10").Resize(1000, 5).ClearContents
Sheet1.Range("A10").Resize(i, 5) = KQ
End Sub

Dạ em báo cáo với anh là em Đã Test code của anh rồi. em xin trả lời 1 từ "Tuyệt" Hoàn toàn đúng ý em, Khi SL bằng 1 thì vẫn *1 anh nhé. Cảm ơn anh nhiều lắm. còn bánh tét qua tết em vào Sài gòn alo anh đi nhậu 1 bữa nhé
Cho em hỏi chổ z = Sheet1.Range("IV3").End(xlToLeft).Column em thay bằng 150 được không vì em 50 tên hàng ( 50 tên hang * 3 cột = 150 )
và anh sửa lại giúp em. Khi tên hàng*SL và Thành tiền =0 thì không xuất ra dữ liệu ( hiện tại Code của anh xuất ra dữ liệu toàn là số 0)

 

[minhtuan55]

Dữ liệu ở đâu mà "quái chiêu" vậy "Chời"?
Mỗi nhóm 3 côt phải liên tục, không có kiểu "4,5,6.......> Đến 50" chen vào "lãng lãng".

Public Sub GPE()
Dim sArr(), dArr(), J As Long, K As Long, Tmp
sArr = Range("B2", Range("B2").End(xlToRight)).Resize(2).Value
ReDim dArr(1 To UBound(sArr, 2), 1 To 5)
For J = 1 To UBound(sArr, 2) Step 3
    If sArr(2, J) <> Empty Then
        K = K + 1: dArr(K, 1) = K
        Tmp = Split(sArr(2, J), "*")
        dArr(K, 2) = Tmp(0)
        If InStr(sArr(2, J), "*") Then dArr(K, 3) = Tmp(1)
        dArr(K, 4) = sArr(2, J + 1)
        dArr(K, 5) = sArr(2, J + 2)
    End If
Next J
Range("A10:E100").ClearContents
If K Then Range("A10:E10").Resize(K) = dArr
End Sub

[/QUOT


Dạ thank anh. Dữ liệu từ 1 file của công ty của em. em cũng không biết ở nữa. Sếp đưa bảo em làm.
"4,5,6.......> Đến 50" là muốn diễn tả trường [Tên hàng * SL] tiếp theo cho tới tên hàng thứ 50.

 

[minhtuan55]

Hai (02) cái bánh tét nhá? Mà dùng công thức được không? Khi số lượng =1 thì có ghi là hàng*1 hay không ghi (*1)?

Sub HangCot()
Dim z As Long, tmp As Variant, k As Long, KQ() As Variant, i As Long, T
z = Sheet1.Range("IV3").End(xlToLeft).Column
tmp = Sheet1.Range("B3").Resize(1, z - 1): z = UBound(tmp, 2)
ReDim KQ(1 To z / 3, 1 To 5)
For k = 1 To z - 2 Step 3
    T = tmp(1, k)
    If T <> "" Then
        i = i + 1: KQ(i, 1) = i
        If InStr(T, "*") Then
            KQ(i, 2) = Split(T, "*")(0): KQ(i, 3) = Split(T, "*")(1)
        Else
            KQ(i, 2) = T: KQ(i, 3) = 1
        End If
        KQ(i, 4) = tmp(1, k + 1): KQ(i, 5) = KQ(i, 3) * KQ(i, 4)
    End If
Next k
Sheet1.Range("A10").Resize(1000, 5).ClearContents
Sheet1.Range("A10").Resize(i, 5) = KQ
End Sub

Anh ơi em mới Test phát hiện ra 1 lỗi anh sửa lại giúp em . Khi tên hàng*SL và Thành tiền =0 thì không xuất ra dữ liệu ( hiện tại Code của anh xuất ra dữ liệu toàn là số 0)

 

[befaint]

Anh ơi em mới Test phát hiện ra 1 lỗi anh sửa lại giúp em . Khi tên hàng*SL và Thành tiền =0 thì không xuất ra dữ liệu ( hiện tại Code của anh xuất ra dữ liệu toàn là số 0)

Bạn gửi file excel lên coi...

 

[minhtuan55]

Bạn gửi file excel lên coi...

Dạ em gửi file đây !

 

[befaint]

Dạ em gửi file đây !

Bạn sửa dòng

If T <> "" Then

thành

If T <> Empty Then

(Hoặc chép lại code ở bài #2)