Chuyển dữ liệu từ cột sản phẩm sang hàng.

[MrBao69]

Chào anh chị,

Lần đầu tiên, em chúc quý anh chị thật nhiều sức khỏe ạ

- Em có 1 file dữ liệu như sau:



- Em muốn chuyển sang bảng như sau:



Nhờ các anh chị có cách nào để xử lý trường hợp này ko ạ?

Chào quý anh chị,

 

[CHAOQUAY]

Chào anh chị,

Lần đầu tiên, em chúc quý anh chị thật nhiều sức khỏe ạ

- Em có 1 file dữ liệu như sau:

View attachment 261951

- Em muốn chuyển sang bảng như sau:

View attachment 261952

Nhờ các anh chị có cách nào để xử lý trường hợp này ko ạ?

Chào quý anh chị,

....................

Sub abc()
Dim nguon
Dim kq
Dim i, j, k
nguon = Sheet1.Range("A1:E4")
ReDim kq(1 To UBound(nguon) * 3, 1 To 4)
k = 0
For i = 2 To UBound(nguon)
    For j = 3 To 5
        If nguon(i, j) <> "" Then
            k = k + 1
            kq(k, 1) = nguon(i, 1)
            kq(k, 2) = nguon(i, 2)
            kq(k, 3) = nguon(1, j)
            kq(k, 4) = nguon(i, j)
        End If
    Next j
Next i
Sheet1.Range("I2").Resize(k, 4) = kq
End Sub

 

[HUONGHCKT]

Chào anh chị,

Lần đầu tiên, em chúc quý anh chị thật nhiều sức khỏe ạ

- Em có 1 file dữ liệu như sau:

View attachment 261951

- Em muốn chuyển sang bảng như sau:

View attachment 261952

Nhờ các anh chị có cách nào để xử lý trường hợp này ko ạ?

Chào quý anh chị,

góp vui trong khi tự giam để chống dịch

 

[be_09]

Chào anh chị,

Lần đầu tiên, em chúc quý anh chị thật nhiều sức khỏe ạ

- Em có 1 file dữ liệu như sau:

View attachment 261951

- Em muốn chuyển sang bảng như sau:

View attachment 261952

Nhờ các anh chị có cách nào để xử lý trường hợp này ko ạ?

Chào quý anh chị,

1/ Nếu thêm một số cột nữa sẽ ảnh hưởng đến việc đặt kết quả tại I2, tôi chuyển đặt kết quả tại M2 để cho bạn dễ bổ sung cột.
2/ Bạn thêm hoặc bớt bất kỳ số dòng từ cột A đến K rồi chạy thử code.

 

[MrBao69]

dạ, em cám ơn.

 

[Hoàng Trọng Hữu]

Chào anh chị,

Lần đầu tiên, em chúc quý anh chị thật nhiều sức khỏe ạ

- Em có 1 file dữ liệu như sau:

View attachment 261951

- Em muốn chuyển sang bảng như sau:

View attachment 261952

Nhờ các anh chị có cách nào để xử lý trường hợp này ko ạ?

Chào quý anh chị,

Nếu bạn lười thì thử đoạn code mình coi thử nhé:

Sub kqchuyen()

Dim nguon

Dim kq

Dim i&, j&, k&

Application.ScreenUpdating = False

Sheet2.Range("A2").CurrentRegion.Offset(1).ClearContents

With Sheet1
lr = .Cells(Rows.Count, 1).End(3).Row

col = .Cells(1, 1).End(xlToRight).Column

nguon = .Range(Cells(1, 1), Cells(lr, col)).Value
ReDim kq(1 To lr * col, 1 To 4)
k = 0
For i = 2 To UBound(nguon, 1)
    For j = 3 To UBound(nguon, 2)
        If nguon(i, j) <> "" Then

            k = k + 1

            kq(k, 1) = nguon(i, 1) '

            kq(k, 2) = nguon(i, 2)

            kq(k, 3) = nguon(1, j)

            kq(k, 4) = nguon(i, j)
        End If

    Next j

        Next i

Sheet2.Range("A2").Resize(k, 4) = kq

End With

Application.ScreenUpdating = True

End Sub

 

[MrBao69]

Nếu bạn lười thì thử đoạn code mình coi thử nhé:

Sub kqchuyen()

Dim nguon

Dim kq

Dim i&, j&, k&

Application.ScreenUpdating = False

Sheet2.Range("A2").CurrentRegion.Offset(1).ClearContents

With Sheet1
lr = .Cells(Rows.Count, 1).End(3).Row

col = .Cells(1, 1).End(xlToRight).Column

nguon = .Range(Cells(1, 1), Cells(lr, col)).Value
ReDim kq(1 To lr * col, 1 To 4)
k = 0
For i = 2 To UBound(nguon, 1)
    For j = 3 To UBound(nguon, 2)
        If nguon(i, j) <> "" Then

            k = k + 1

            kq(k, 1) = nguon(i, 1) '

            kq(k, 2) = nguon(i, 2)

            kq(k, 3) = nguon(1, j)

            kq(k, 4) = nguon(i, j)
        End If

    Next j

        Next i

Sheet2.Range("A2").Resize(k, 4) = kq

End With

Application.ScreenUpdating = True

End Sub

Code chạy ổn, em cám ơn ạ.