Trình bày lại dữ liệu Vùng tính cột C , thêm mới các dòng tiêu đề lấy theo số phiếu ở cột A (1 người xem)

[Excel my love_1]

Em có 1 bảng tính dùng để cập nhập vào hóa đơn điện tử
Em muốn từ vùng dữ liệu A2:M2 tạo ra vùng dữ liệu có kiểu trình bày ở các dòng cột C thêm mới các dòng tiêu đề theo các phiếu xuất ở cột A
------------------------
Ví dụ vùng từ từ C2:C4 là các hàng hóa của Phiếu xuất X01S0072 (vùng A2:A4).
Cột C sẽ trình bày là thêm 1 dòng tiêu đề ở bên trên là X01S0072, rồi mới đến các dòng hàng hóa có trong phiếu xuất đó
Tiếp vùng C5:C6 của X01S0107 sẽ có dòng tiêu đề là X01S0107...
Dòng tiêu đề mới được tạo ra ngoại trừ ô ở cột C, các ô còn lại của dòng tiêu đề đều có dữ liệu = 0
Mong các anh chị giúp đỡ ạ
Kết quả mong muốn em đã trình bày ở vùng A14:M28
Chi tiết các anh chị xem file em gửi kèm nhé
Em xin cảm ơn

 

[be_09]

Em có 1 bảng tính dùng để cập nhập vào hóa đơn điện tử
Em muốn từ vùng dữ liệu A2:M2 tạo ra vùng dữ liệu có kiểu trình bày ở các dòng cột C thêm mới các dòng tiêu đề theo các phiếu xuất ở cột A
------------------------
Ví dụ vùng từ từ C2:C4 là các hàng hóa của Phiếu xuất X01S0072 (vùng A2:A4).
Cột C sẽ trình bày là thêm 1 dòng tiêu đề ở bên trên là X01S0072, rồi mới đến các dòng hàng hóa có trong phiếu xuất đó
Tiếp vùng C5:C6 của X01S0107 sẽ có dòng tiêu đề là X01S0107...
Dòng tiêu đề mới được tạo ra ngoại trừ ô ở cột C, các ô còn lại của dòng tiêu đề đều có dữ liệu = 0
Mong các anh chị giúp đỡ ạ
Kết quả mong muốn em đã trình bày ở vùng A14:M28
Chi tiết các anh chị xem file em gửi kèm nhé
Em xin cảm ơn

1/ Xem xong chẳng hiểu bạn muốn làm cái gì ?
2/ Phiếu xuất là như thế nào sao không chụp hình đưa lên để mọi người chiêm ngưỡng.

 

[SA_DQ]

1 trong những macro bạn cần là đây & xin mời bạn thử:

Sub TachSoCT()
 Dim Rng As Range
 Const FX As String = "Phieu xuat: "
 Dim SCT As String
 Dim Rws As Long, W As Long, J As Long, Col As Integer
 
 Set Rng = [C1].CurrentRegion
 Rws = Rng.Rows.Count
 ReDim Arr(1 To 2 * Rws, 1 To Rng.Columns.Count)
 [A30].Resize(2 * Rws, Rng.Columns.Count).Value = Arr()
 For J = 2 To Rws
    If Cells(J, "A").Value <> SCT And Cells(J, "A").Value <> "" Then
        W = W + 1:          Arr(W, 1) = 0
        Arr(W, 2) = 0:      SCT = Cells(J, "A").Value
        Arr(W, 3) = FX & SCT
        W = W + 1
        For Col = 1 To Rng.Columns.Count
            Arr(W, Col) = Cells(J, Col).Value
        Next Col
    ElseIf Cells(J, "A").Value = SCT Then
        W = W + 1
        For Col = 1 To Rng.Columns.Count
            Arr(W, Col) = Cells(J, Col).Value
        Next Col
    ElseIf Cells(J, "A").Value = "" Then
        W = W + 1
        For Col = 3 To Rng.Columns.Count
            Arr(W, Col) = Cells(J, Col).Value
        Next Col
    End If
 Next J 
 [A30].Resize(W, Rng.Columns.Count).Value = Arr()
End Sub

 

[Excel my love_1]

1 trong những macro bạn cần là đây & xin mời bạn thử:

Sub TachSoCT()
...........................
End Sub

Cháu cảm ơn bác SA_DQ nhiều ạ. Code của bác gần hoàn hảo như cháu muốn rồi ạ, chỉ bị thiếu 1 xíu nữa là , ở phần kết quả sau khi chạy code của bác, cháu muốn điền giá trị = 0 cho các ô từ cột D đến Cột M của các dòng được tạo mới bằng code. Bác giúp cháu nốt với ạ
Chi tiết cháu gửi lại file ạ

Bài đã được tự động gộp: 28/2/21

1/ Xem xong chẳng hiểu bạn muốn làm cái gì ?
2/ Phiếu xuất là như thế nào sao không chụp hình đưa lên để mọi người chiêm ngưỡng.

Chắc tại em trình bày rườm rà quá anh à
Cảm ơn anh đã góp ý

 

[SA_DQ]

Thử xài cặp macro này xem đúng ý bạn không:

Dim W As Long, J As Long, Col As Integer, Cot As Integer
Dim Arr()
Sub TachSoCT()
Dim Rng As Range
Const FX As String = "Phieu xuat: "
Dim SCT As String
Dim Rws As Long

Set Rng = [C1].CurrentRegion
Rws = Rng.Rows.Count
Cot = Rng.Columns.Count
ReDim Arr(1 To 2 * Rws, 1 To Cot)
[A30].Resize(2 * Rws, Rng.Columns.Count).Value = Arr()
For J = 2 To Rws
    If Cells(J, "A").Value <> SCT And Cells(J, "A").Value <> "" Then
        W = W + 1
        SCT = Cells(J, "A").Value
        For Col = 1 To Rng.Columns.Count
            Arr(W, Col) = 0
        Next Col
        Arr(W, 3) = FX & SCT:   GPE W, Col, J
    ElseIf Cells(J, "A").Value = SCT Then
        GPE W, Col, J
    ElseIf Cells(J, "A").Value = "" Then
'        GPE W, Col, J
        W = W + 1
        For Col = 3 To Rng.Columns.Count
            Arr(W, Col) = Cells(J, Col).Value
        Next Col
    End If
Next J
[A30].Resize(W, Cot).Value = Arr()
End Sub

Sub GPE(W As Long, Col As Integer, J As Long)
W = W + 1
For Col = 1 To Cot
    Arr(W, Col) = Cells(J, Col).Value
Next Col
End Sub

 

[be_09]

Chắc tại em trình bày rườm rà quá anh à
Cảm ơn anh đã góp ý

Góp ý cho bạn:
1/ Nên sử dụng SheetForm để tạo phiêu xuất để nhập liệu và dùng nó để in phiếu xuất. Khi xuất phiếu xong thì lưu vào sheet theo dõi như bạn đã nhờ trợ giúp.
2/ Để nhập liệu. nhập liệu nhanh và đồng nhất cần có 1 sheet chứa danh mục vật tư với đơn vị tính và đơn giá.
3/ Nên sử dụng kết quả kiểu cũ của bạn để thuận tiện cho việc sử dụng PivotTable trong báo cáo. Nội dung như bài 1 về phần trình bày chỉ làm cho đẹp mà thôi.

 

[Excel my love_1]

Thử xài cặp macro này xem đúng ý bạn không:

Dim W As Long, J As Long, Col As Integer, Cot As Integer
Dim Arr()
Sub TachSoCT()
Dim Rng As Range
Const FX As String = "Phieu xuat: "
Dim SCT As String
Dim Rws As Long

Set Rng = [C1].CurrentRegion
Rws = Rng.Rows.Count
Cot = Rng.Columns.Count
ReDim Arr(1 To 2 * Rws, 1 To Cot)
[A30].Resize(2 * Rws, Rng.Columns.Count).Value = Arr()
For J = 2 To Rws
    If Cells(J, "A").Value <> SCT And Cells(J, "A").Value <> "" Then
        W = W + 1
        SCT = Cells(J, "A").Value
        For Col = 1 To Rng.Columns.Count
            Arr(W, Col) = 0
        Next Col
        Arr(W, 3) = FX & SCT:   GPE W, Col, J
    ElseIf Cells(J, "A").Value = SCT Then
        GPE W, Col, J
    ElseIf Cells(J, "A").Value = "" Then
'        GPE W, Col, J
        W = W + 1
        For Col = 3 To Rng.Columns.Count
            Arr(W, Col) = Cells(J, Col).Value
        Next Col
    End If
Next J
[A30].Resize(W, Cot).Value = Arr()
End Sub

Sub GPE(W As Long, Col As Integer, J As Long)
W = W + 1
For Col = 1 To Cot
    Arr(W, Col) = Cells(J, Col).Value
Next Col
End Sub

Dạ cảm ơn bác ạ

 

[Ba Tê]

Chắc tại em trình bày rườm rà quá anh à

Sao dòng tiêu đề không có tổng của số lượng, thành tiền, VAT luôn, mà cho tất cả =0?
Bạn xem file: