Chuyển bảng dữ liệu từ ma trận sang bảng dọc (3 người xem)

[amateurboy]

Mình làm kế toán có file định mức muốn chuyển từ dạng ma trận sheet 1:


sang dạng cột dọc trong sheet 2. Không biết phải dùng công thức excel như thế nào.


P/s: Vì số lượng món quá nhiều nên trong sheet 1 ở đây mình chỉ để 10 món (hàng) x 15 nguyên liệu (cột) tượng trưng, thực tế phải 100 món x hơn 100 nguyên liệu, làm thủ công ko nổi.

Mong nhận góp ý từ mọi người!

 

[Phuocam]

Không biết phải dùng công thức excel như thế nào.
thực tế phải 100 món x hơn 100 nguyên liệu, làm thủ công ko nổi.

Công thức với hơn 100x100 = 10000 kết quả chắc chạy không nổi. Bạn có thích dùng VBA ?

 

[amateurboy]

Ok bạn ơi. Vậy phiền bạn giúp mình tại VBA mình cũng ko biết gì nhiều.

 

[amateurboy]

Thử Sub:

Public Sub GPE()
Dim sArr, dArr, I As Long, K As Long, N As Long, J As Long, Stt As Long
sArr = Sheet1.Range("A5", Sheet1.Range("A" & Rows.Count).End(3)).Resize(, 30).Value
ReDim dArr(1 To UBound(sArr) * 10, 1 To 8)
Application.ScreenUpdating = False
For I = 6 To UBound(sArr)
    If IsNumeric(sArr(I, 1)) Then
        Stt = Stt + 1
        N = 0
        For J = 5 To UBound(sArr, 2)
            If Len(sArr(1, J)) Then
                If sArr(I, J) <> 0 Then
                N = N + 1
                K = K + 1
                If N = 1 Then
                    dArr(K, 1) = Stt
                    dArr(K, 2) = sArr(I, 2)
                    dArr(K, 3) = sArr(I, 3)
                    dArr(K, 4) = sArr(I, 4)
                End If
                dArr(K, 5) = sArr(3, J)
                dArr(K, 6) = sArr(1, J)
                dArr(K, 7) = sArr(4, J)
                dArr(K, 8) = sArr(I, J)
                End If
            End If
        Next
    End If
Next
    If K Then
        With Sheet2
            .Range("A7").Resize(1000, 9).ClearContents
            .Range("A7").Resize(K, 8).Value = dArr
        End With
    End If
MsgBox "Done!"
Application.ScreenUpdating = True
End Sub

Chạy nhanh thật. Toẹt vời thiệt!
Công thức đọc không hiểu lắm, chắc phải đọc hết quyển Lập trình VBA của Phan Tự Hướng mới mua rồi mới coi code và mạn phép hỏi bạn thêm. )
Thank bạn!!!!!!!

 

[Ba Tê]

Chạy nhanh thật. Toẹt vời thiệt!
Công thức đọc không hiểu lắm, chắc phải đọc hết quyển Lập trình VBA của Phan Tự Hướng mới mua rồi mới coi code và mạn phép hỏi bạn thêm. )
Thank bạn!!!!!!!

Một cách viết khác cho bạn tham khảo.

Option Explicit

Public Sub S_Gpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Rws As Long, Col As Long
With Sheet1
    Col = .Range("E5").End(xlToRight).Column
    sArr = .Range("A5", .Range("B9").End(xlDown)).Resize(, Col).Value
    Rws = UBound(sArr)
    ReDim dArr(1 To Rws * Col, 1 To 8)
End With
For I = 6 To Rws
    K = K + 1
    For J = 1 To 4
        dArr(K, J) = sArr(I, J)
    Next J
    K = K - 1
    For J = 5 To Col
        If sArr(I, J) <> Empty Then
            K = K + 1
            dArr(K, 5) = sArr(3, J)
            dArr(K, 6) = sArr(1, J)
            dArr(K, 7) = sArr(4, J)
            dArr(K, 8) = sArr(I, J)
        End If
    Next J
Next I
Sheet2.Range("J7").Resize(1000, 8).ClearContents
Sheet2.Range("J7").Resize(K, 8) = dArr
End Sub