Hoàn thiện dùm em code lọc (1 người xem)

[bebeen]

Các AC! Em có bài này, không hiểu sao code không cho kết quả theo ý muốn?
Nhờ AC xem dùm cho em nhé!

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim dongcuoi&, dcuoi&, j&
        Application.ScreenUpdating = 0
        On Error Resume Next
        If Target.Address = "$D$8" Then
            S5.Range("A13:I30000").Clear
            With S1.Range(S1.[a1], S1.[A30000].End(3)).Resize(, 18)
                .AutoFilter 2, ">=" & CLng(S5.Range("E5").Value), 1, "<=" & CLng(S5.Range("E6").Value)
                .AutoFilter 5, S5.Range("D8")
                .Offset(1, 1).Resize(, 3).SpecialCells(12).Copy S5.Range("A13")
                .Offset(1, 6).Resize(, 1).SpecialCells(12).Copy S5.Range("D13")
                .Offset(1, 9).Resize(, 4).SpecialCells(12).Copy S5.Range("E13")
                .Offset(1, 16).Resize(, 1).SpecialCells(12).Copy S5.Range("I13")
                .AutoFilter
                dongcuoi = S5.Range("A30000").End(3).Row
                '----------------------------
                'Doan code mau xanh o duoi em viet nhu vay de khong cho hien nhung noi dung
                'giong nhau cua moi nghiep vu. Ví du: 1 ctu co 2 hoac nhieu hon cac nghiep vu
                'phat sinh thi no chi hien 1 dong dau (ngay, so ctu va ngay ctu), cac dong
                'sau khong hien nua!
                '----------------------------
'                With S5
'                    For j = dongcuoi To 13 Step -1
'                        If .Cells(j, 1) & .Cells(j, 2) & .Cells(j, 3) = .Cells(j - 1, 1) & _
'                        .Cells(j - 1, 2) & .Cells(j - 1, 3) Then .Cells(j, 1).Resize(, 3) = Empty
'                    Next
'                End With
                Addborder S5.Range("A13:I" & dongcuoi + 1)
                S6.Range("A4:I12").Copy S5.[A30000].End(3).Offset(1)
                S5.Cells(dongcuoi + 1, 6).Resize(, 1).Value = "=+SUM(R13C:R[-1]C)"
                S5.Cells(dongcuoi + 1, 8).Resize(, 2).Value = "=+SUM(R13C:R[-1]C)"
                S5.Cells(dongcuoi + 1, 6).Resize(, 1).Value = S5.Cells(dongcuoi + 1, 6).Resize(, 1).Value
                S5.Cells(dongcuoi + 1, 8).Resize(, 2).Value = S5.Cells(dongcuoi + 1, 8).Resize(, 2).Value
            End With
        End If
End Sub

 

[ChanhTQ@]

Bạn chiêm nghiệm với đoạn mã sau

Option Explicit
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
 Dim DongCuoi As Long, J As Long
        
 Application.ScreenUpdating = 0
 On Error Resume Next
 If Target.Address = "$D$8" Then
    S5.Range("A13:I30000").Clear
    With S1.Range(S1.[a1], S1.[A30000].End(3)).Resize(, 18)
        .AutoFilter 2, ">=" & CLng(S5.Range("E5").Value), 1, "<=" & CLng(S5.Range("E6").Value)
        .AutoFilter 5, S5.Range("D8")
        .Offset(1, 1).Resize(, 3).SpecialCells(12).Copy S5.Range("A13")
        .Offset(1, 6).Resize(, 1).SpecialCells(12).Copy S5.Range("D13")
        .Offset(1, 9).Resize(, 4).SpecialCells(12).Copy S5.Range("E13")
        .Offset(1, 16).Resize(, 1).SpecialCells(12).Copy S5.Range("I13")
        .AutoFilter
        DongCuoi = S5.Range("A30000").End(3).Row
    End With
'[COLOR=#0000cd]Doan code màu xanh o duói em viét nhu vay de khong cho hien nhung noi dung[/COLOR]
'[COLOR=#0000cd]gióng nhau cua moi nghiep vu. Ví du: 1 ctù có 2 hoac nhièu hon các nghiep vu[/COLOR]
'[COLOR=#0000cd]phát sinh thì nó chi hien 1 dòng dàu (ngày, só ctù va ngày ctù), các dòng[/COLOR]
'[COLOR=#0000cd]sau khong hien nua![/COLOR]
    For J = 14 To DongCuoi
        With S5.Cells(J, 1)
            If .Value = .Offset(-1) And .Offset(, 1) = .Offset(-1, 1) And .Offset(, 2) = .Offset(-1, 2) Then
                .Resize(, 3).Font.ColorIndex = 2
            End If
        End With
    Next J
    Addborder S5.Range("A13:I" & DongCuoi + 1)
9    S6.Range("A4:I12").Copy S5.[A30000].End(3).Offset(1)
    S5.Cells(DongCuoi + 1, 6).Resize(, 1).Value = "=+SUM(R13C:R[-1]C)"
    S5.Cells(DongCuoi + 1, 8).Resize(, 2).Value = "=+SUM(R13C:R[-1]C)"
    S5.Cells(DongCuoi + 1, 6).Resize(, 1).Value = S5.Cells(DongCuoi + 1, 6).Resize(, 1).Value
    S5.Cells(DongCuoi + 1, 8).Resize(, 2).Value = S5.Cells(DongCuoi + 1, 8).Resize(, 2).Value
 End If
[B]End Sub[/B]

Chú í: Thực ra trong đoạn mã trên chỉ chuyển màu font chữ đi mà thôi;

Nếu bạn vẫn thích xóa nội dung các dòng trùng này thì cần chỉnh sửa dòng lệnh mang số 9;
Nhưng mình nói trước để bạn đề fòng rằng, chỉnh sửa không fải dễ nếu 1 khi nhiều dòng cuối trùng nghiệp vụ!

Chúc thành công!

 

[bebeen]

Option Explicit
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
 Dim DongCuoi As Long, J As Long
        
 Application.ScreenUpdating = 0
 On Error Resume Next
 If Target.Address = "$D$8" Then
    S5.Range("A13:I30000").Clear
    With S1.Range(S1.[a1], S1.[A30000].End(3)).Resize(, 18)
        .AutoFilter 2, ">=" & CLng(S5.Range("E5").Value), 1, "<=" & CLng(S5.Range("E6").Value)
        .AutoFilter 5, S5.Range("D8")
        .Offset(1, 1).Resize(, 3).SpecialCells(12).Copy S5.Range("A13")
        .Offset(1, 6).Resize(, 1).SpecialCells(12).Copy S5.Range("D13")
        .Offset(1, 9).Resize(, 4).SpecialCells(12).Copy S5.Range("E13")
        .Offset(1, 16).Resize(, 1).SpecialCells(12).Copy S5.Range("I13")
        .AutoFilter
        DongCuoi = S5.Range("A30000").End(3).Row
    End With
'[COLOR=#0000cd]Doan code màu xanh o duói em viét nhu vay de khong cho hien nhung noi dung[/COLOR]
'[COLOR=#0000cd]gióng nhau cua moi nghiep vu. Ví du: 1 ctù có 2 hoac nhièu hon các nghiep vu[/COLOR]
'[COLOR=#0000cd]phát sinh thì nó chi hien 1 dòng dàu (ngày, só ctù va ngày ctù), các dòng[/COLOR]
'[COLOR=#0000cd]sau khong hien nua![/COLOR]
    For J = 14 To DongCuoi
        With S5.Cells(J, 1)
            If .Value = .Offset(-1) And .Offset(, 1) = .Offset(-1, 1) And .Offset(, 2) = .Offset(-1, 2) Then
                .Resize(, 3).Font.ColorIndex = 2
            End If
        End With
    Next J
    Addborder S5.Range("A13:I" & DongCuoi + 1)
9    S6.Range("A4:I12").Copy S5.[A30000].End(3).Offset(1)
    S5.Cells(DongCuoi + 1, 6).Resize(, 1).Value = "=+SUM(R13C:R[-1]C)"
    S5.Cells(DongCuoi + 1, 8).Resize(, 2).Value = "=+SUM(R13C:R[-1]C)"
    S5.Cells(DongCuoi + 1, 6).Resize(, 1).Value = S5.Cells(DongCuoi + 1, 6).Resize(, 1).Value
    S5.Cells(DongCuoi + 1, 8).Resize(, 2).Value = S5.Cells(DongCuoi + 1, 8).Resize(, 2).Value
 End If
[B]End Sub[/B]

Chú í: Thực ra trong đoạn mã trên chỉ chuyển màu font chữ đi mà thôi;

Nếu bạn vẫn thích xóa nội dung các dòng trùng này thì cần chỉnh sửa dòng lệnh mang số 9;
Nhưng mình nói trước để bạn đề fòng rằng, chỉnh sửa không fải dễ nếu 1 khi nhiều dòng cuối trùng nghiệp vụ!

Chúc thành công!

Chính vì dòng số 9 này mà cả đêm hôm qua em không ngủ được với nó. Đến giờ vẫn chưa nghĩ ra. Nhờ anh chi thêm cho em được mở tầm mắt nhé!

 

[SA_DQ]

Dòng lệnh mang số 9 đó có thể sửa thành

Chính vì dòng số 9 mà cả đêm hôm qua em không ngủ được với nó. Đến giờ vẫn chưa nghĩ ra. Nhờ anh chi thêm cho em nhé!

9    S6.Range("FTER").Copy S5.Range("A" & DCuoi + 1)

Ngoài ra xin gọi í bạn 1 cách hoàn toàn khác; lúc rỗi bạn làm thử:

Trên trang tính S5, bạn thiết lập sẵn dòng tổng cộng ở dòng 999 (hay hơn tùy í)

Dưới đó là nội dung Form footer (là vùng gán tên "FTER")

Sau khi copy dữ liệu thì ta cho ẩn đi các hàng trống (không dữ liệu) trước dòng 999 này đi.