Tống hợp báo cáo theo nhiều điều kiện (1 người xem)

[keepwilling]

Em vừa lập 1 chương trình báo cáo có tham khảo từ rất nhiều các tài liệu của các anh chị trên diễn đàn. Nhưng do kiến thức có hạn (em cũng mới tập tành VBA thui), nên em chỉ làm được đến phần nhập dữ liệu vào. Mong các anh chị giúp em hoàn thiện phần tồng hợp báo cáo theo nhiều điều kiện. Em cảm ơn!!!
Do em không thể up lên được, phiền các anh chị download theo link sau:

https://www.dropbox.com/s/0lwkguwm55atcga/project.xls

 

[jack nt]

[h=3]bạn xem lại link:


Nothing Here
[/h][h=4]The file you're looking for has been deleted or moved.[/h]

 

[keepwilling]

Em xin lỗi, em up lại link nhé. Anh chị giúp em với ạ
https://www.dropbox.com/s/ebcddf681eklmu3/REPORT.xls

 

[dhn46]

Bạn Call sub này cho sự kiện combobox change của 3 combobox trong sheet Report

Sub Loc()
    Dim i   As Long
    Dim DItem As String
    Dim DName As String
    Dim Class As String
    Dim TotalQty As Long
    Dim Arr, Res
    Application.ScreenUpdating = False
    S04.Range("B8:I65536").Delete
    Arr = S03.Range("A2:L" & S03.Range("A65536").End(3).Row)
    ReDim Res(1 To UBound(Arr, 1), 1 To 8)
    If S04.[D4] = "" Then
        DItem = "*"
    Else
        DItem = S04.[D4]
    End If
    If S04.[D5] = "" Then
        DName = "*"
    Else
        DName = S04.[D5]
    End If
    If S04.[G4] = "" Then
        Class = "*"
    Else
        Class = S04.[G4]
    End If
    For i = 1 To UBound(Arr, 1)
        If Arr(i, 5) >= S04.[E2] And Arr(i, 5) <= S04.[F2] Then
            If Arr(i, 9) Like DItem Then
                If Arr(i, 7) Like DName Then
                    If Arr(i, 11) Like Class Then
                        k = k + 1
                        Res(k, 1) = k
                        Res(k, 2) = Arr(i, 1)
                        Res(k, 3) = Arr(i, 5)
                        Res(k, 4) = Arr(i, 7)
                        Res(k, 5) = Arr(i, 8)
                        Res(k, 6) = Arr(i, 9)
                        Res(k, 7) = Arr(i, 10)
                        Res(k, 8) = Arr(i, 11)
                        TotalQty = TotalQty + Arr(i, 10)
                    End If
                End If
            End If
        End If
    Next
    If k Then
        With S04
            .Range("B8").Resize(k, 8) = Res
            .Range("F" & k + 8) = "Sum"
            .Range("H" & k + 8) = TotalQty
            .Range("B" & k + 8 & ":I" & k + 8).Font.Bold = True
            .Range("B" & k + 8 & ":I" & k + 8).Interior.Color = 16777164
            .Range("B8:I" & k + 8).BorderAround 6, xlMedium
            .Range("B8:I" & k + 8).Borders(xlInsideHorizontal).Weight = 1
            .Range("B8:I" & k + 8).Borders(xlInsideVertical).Weight = 1
        End With
    End If
    Application.ScreenUpdating = True
End Sub

 

[keepwilling]

Cảm ơn bạn dhn46 . Nhưng nếu mình muốn chọn 1 trong 3 điều kiện ( Hoặc Item, Name, Class) thì phải làm thế nào?

 

[dhn46]

Cảm ơn bạn dhn46 . Nhưng nếu mình muốn chọn 1 trong 3 điều kiện ( Hoặc Item, Name, Class) thì phải làm thế nào?

Thì bạn cứ Call Loc tại sự kiện change của 3 Combobox rồi thay đổi từng cái xem như thế nào. Lập trình là phải thử mới biết chứ đoán thì khó lắm bạn ơi.

 

[keepwilling]

Mình sẽ ngâm cứu tiếp xem sao.

 

[dhn46]

Bạn thêm Call loc cho Combobox là như thế này
- Combobox AMREP

Private Sub AMREP_Change()
    On Error Resume Next
    If ActiveSheet.Name <> S04.Name Then Exit Sub
    If S04.AMREP.Visible = False Then Exit Sub
    If Not Intersect(ActiveCell, Range("E1"), Range("D4:D5"), Range("G4")) Is Nothing Then Exit Sub
    ActiveCell.Offset(0, 1).Value = S04.AMREP.Column(1)
    If ActiveCell.Address = "$D$1" Then S04.Range("D4:E5, G4").ClearContents
[COLOR=#ff0000][B]    Call Loc[/B][/COLOR]
End Sub

Tôi thấy bạn đã biết vận dụng khá nhiều Code vào File nên việc này chắc là trong tầm tay bạn rồi. Chúc bạn thành công!

 

[keepwilling]

Cảm ơn bạn đã nhiệt tình quan tâm tới đề tài này. Mình đã sửa lại code theo Vlookup như ban đầu. Mình viết như sau:

Sub Loc()
On Error Resume Next
Dim HC As Long
Dim i As Long
Dim ND As Date
Dim NC As Date
Dim Ma As Range
Dim BC As String
Dim Tim As Boolean
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
HC = S04.Range("E65500").End(xlUp).Row

S04.Select
S04.Range("A8:I" & HC + 1).ClearContents
S04.Range("A9:L" & HC + 2).Select
Call NLine
ND = S04.Range("E2").Value
NC = S04.Range("F2").Value
HC = S03.Range("A65000").End(xlUp).Row

Tim = False
i = 7

For Each Ma In S03.Range("A2:A" & HC)
'MsgBox Ma

If Ma.Offset(0, 4).Value >= ND And Ma.Offset(0, 4).Value <= NC Then
If Ma.Offset(0, 3) = S04.Range("D4") Or S04.Range("D4") = "" Then
If Ma.Offset(0, 8) = S04.Range("D5") Or S04.Range("D5") = "" Then
If Ma.Offset(0, 6) = S04.Range("G4") Or S04.Range("G4") = "" Then
If Ma.Offset(0, 10) = S04.Range("G5") Or S04.Range("G5") = "" Then
Tim = True

End If: End If: End If: End If: End If


If Tim = True Then
i = i + 1
Range("A" & i) = i - 7
Range("B" & i) = Ma
Range("D" & i) = Ma.Offset(0, 4)

Range("C" & i) = Ma.Offset(0, 3)
Range("C" & i) = WorksheetFunction.VLookup(Range("C" & i), S01.Range("Model"), 1, 0)


Range("E" & i) = Ma.Offset(0, 6)
If Range("E" & i) <> "" Then Range("F" & i) = WorksheetFunction.VLookup(Range("E" & i), S01.Range("Dename"), 2, 0)
Range("E" & i) = Ma.Offset(0, 6)

If Range("E" & i) <> "" Then Range("F" & i) = WorksheetFunction.VLookup(Range("E" & i), S01.Range("Dename"), 2, 0)

Range("G" & i) = Ma.Offset(0, 8)
Range("G" & i) = WorksheetFunction.VLookup(Range("G" & i), S01.Range("Item"), 1, 0)

Range("I" & i) = Ma.Offset(0, 10)
Range("I" & i) = WorksheetFunction.VLookup(Range("I" & i), S01.Range("DClass"), 1, 0)

Range("H" & i) = Ma.Offset(0, 9)

End If
Tim = False
Next
If i < 10 Then i = 10
S04.Range("G" & i + 2) = "SUM"
S04.Range("H" & i + 2) = WorksheetFunction.Sum(S04.Range("H8:H" & i))

S04.Range("A9:I" & i + 1).Select
Call YLine
S04.Range("A" & i + 2 & ":I" & i + 2).Select
Call YLineTC
Range("G5").Select
Application.EnableEvents = True
Set Ma = Nothing
Application.ScreenUpdating = True


End Sub

https://www.dropbox.com/s/uwu3mq1yxtnohag/REPORT2.xls

- Tuy nhiên sau khi tạo một report mới, mình thấy bảng hay bị lỗi font, hoặc 1 số dòng của dữ liệu cũ không được xóa hết. Bạn có thể xem giúp mình nhé. Thanks

 

[dhn46]

Cảm ơn bạn đã nhiệt tình quan tâm tới đề tài này. Mình đã sửa lại code theo Vlookup như ban đầu. Mình viết như sau:

https://www.dropbox.com/s/uwu3mq1yxtnohag/REPORT2.xls

- Tuy nhiên sau khi tạo một report mới, mình thấy bảng hay bị lỗi font, hoặc 1 số dòng của dữ liệu cũ không được xóa hết. Bạn có thể xem giúp mình nhé. Thanks

Tôi có đọc qua Code của bạn nhưng cũng chưa hiểu rõ ý của bạn

1/ Phần màu xanh: Lỗi có thể do bạn định dạng thủ công vùng dữ liệu nhở hơn vùng kết quả => Bạn có thể dùng Code để định dạng phần này

2/ Phần màu cam: Bạn dùng

S04.Range("A8:I" & HC + 1).ClearContents

để xóa vùng dữ liệu trên S04 trước khi tiến hành lọc => Bạn thử kiểm tra xem tại cột E nơi bạn xác định HC xem có ô nào khác trống hay không.

 

[keepwilling]

Tôi có đọc qua Code của bạn nhưng cũng chưa hiểu rõ ý của bạn

1/ Phần màu xanh: Lỗi có thể do bạn định dạng thủ công vùng dữ liệu nhở hơn vùng kết quả => Bạn có thể dùng Code để định dạng phần này

2/ Phần màu cam: Bạn dùng

để xóa vùng dữ liệu trên S04 trước khi tiến hành lọc => Bạn thử kiểm tra xem tại cột E nơi bạn xác định HC xem có ô nào khác trống hay không.

Mình hiểu rùi. Cảm ơn bạn nhé