Nhờ dùng VBA để lọc dữ liệu theo điều kiện sau đó tính tổng (1 người xem)

[minhquang92]

Kính chào các anh chị,
Em có dạng dữ liệu như file đính kèm, muốn nhờ các anh chị giúp code để xử lý lại, cụ thể như sau ạ:
- Sheet "Data" là dữ liệu form có sẵn (mỗi tháng sẽ thay đổi em sẽ paste đè dữ liệu mới vào)
- Sheet "Điều kiện sort" là để liệt kê các phương thức thanh toán mà dùng tiền mặt (dựa theo Payment method ở cột H bên data) , hiện nay đang gồm "cod" và "cash", nhưng có thể data sau này lại thêm phương thức khác nào đó mà cũng là tiền mặt, nên sẽ để thành 1 cột A để liệt kê. Các phương thức không ở trong cột A này thì là thẻ.
- Sheet "Output" là cái mà em muốn có ạ, bao gồm:
+ Sort lại "Data" theo "điều kiện sort" lên trên, các phương thức không nằm trong "Điều kiện sort" ở dưới.
+ Thêm các dòng tính màu đỏ.
Vậy kính nhờ anh chị giúp đỡ ạ.

 

[bebo021999]

4 sheet:
Sheet "Data"
Sheet "Temp": sheet mẫu sẽ được copy qua sheet Ketqua
Sheet "Sort": Với danh sách ưu tiên tại cột A
Sheet "Ketqua": copy từ sheet "Temp", sau đó insert thêm dòng để chèn dữ liệu từ "Data"
Nhấn nút "RUN" từ sheet "Data" để chạy code.

Option Explicit
Sub test()
Dim lr&, i&, j&, k&, rng, res(), cell As Range
Dim thu As Double, vat As Double, code As Double
Application.ScreenUpdating = False
If Evaluate("=ISREF(Ketqua!A1)") Then Sheets("Ketqua").Delete
Sheets("Temp").Copy after:=Sheets("Data")
ActiveSheet.Name = "Ketqua"
With Sheets("Data")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("A2:S" & lr).Copy
End With
With Sheets("Ketqua")
    .Range("A2").Insert shift:=xlDown
    With .Range("T2:T" & lr)
        .Formula = "=IFERROR(MATCH(H2,Sort!$A$2:$A$10000,0),999)"
        .Value = .Value
        Range("A2:T" & lr).Sort key1:=Range("T1")
    End With
    For Each cell In Range("T2:T" & lr)
        With cell
            If .Value < 999 Then
                thu = thu + .Offset(, -9)
                vat = vat + .Offset(, -7)
                code = code + .Offset(, -3)
            Else
                .EntireRow.Insert
                .Offset(-1, -9).Value = thu
                .Offset(-1, -7).Value = vat
                .Offset(-1, -3).Value = code
                .Offset(-1, -3).Value = code
                With .Offset(-1, -18).Resize(1, 16)
                    .Cells(1, 1).Value = Sheets("Sort").Range("D1").Value
                    .Font.Italic = True
                    .Font.Bold = True
                    .Font.Color = vbRed
                    .NumberFormat = "#,###"
                End With
                Exit For
            End If
        End With
    Next
    .Cells(lr + 2, "K").Value = Evaluate("=sum(K2:K" & lr + 1 & ")") - thu * 2
    .Cells(lr + 2, "M").Value = Evaluate("=sum(M2:M" & lr + 1 & ")") - vat * 2
    .Cells(lr + 2, "Q").Value = Evaluate("=sum(Q2:Q" & lr + 1 & ")") - code * 2
    .Range("T2:T10000").ClearContents
    .Cells(lr + 4, "K").Value = .Cells(lr + 2, "K").Value + thu
    .Cells(lr + 4, "M").Value = .Cells(lr + 2, "M").Value + vat
    .Cells(lr + 5, "M").Value = .Cells(lr + 4, "M").Value * 0.1
    .Cells(lr + 6, "M").Value = .Cells(lr + 4, "M").Value + .Cells(lr + 5, "M").Value
    .Cells(lr + 9, "M").Value = .Cells(lr + 6, "M").Value
    .Cells(lr + 10, "M").Value = code
    .Cells(lr + 11, "M").Value = .Cells(lr + 2, "K").Value
    .Cells(lr + 12, "M").Value = .Cells(lr + 11, "M").Value + .Cells(lr + 10, "M").Value - .Cells(lr + 9, "M").Value
End With
Application.ScreenUpdating = True
End Sub

 

[minhquang92]

EM cảm ơn anh nhiều ạ.