Hoàn thiện dùm code lọc dữ liệu (2 người xem)

[NH_DK]

Em loay hoay mãi mà vẫn không xử lý được code lọc sổ chi tiết này. Giờ em đưa bài lên đây nhờ các AC xem và hoàn thiện dùm em nhé!

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim eR
    Dim i As Long
    Set eR = s1.Range("A3000").End(3)
    Application.ScreenUpdating = False
    On Error Resume Next
    If Target.Address = "$D$6" Then
        Range("A13:J30000").Clear
        With s1.Range(s1.[A1], s1.[A30000].End(3)).Offset(1).Resize(, 16)
            .AutoFilter 2, ">=" & CLng(Range("K1").Value), 1, "<=" & CLng(Range("K2").Value)
            .AutoFilter 10, Range("D6")
            .Offset(1, -1).Resize(, 1).SpecialCells(12).Copy Range("A13") 'Sao dong nay van chua dung ah?
            .Offset(1, 8).Resize(, 1).SpecialCells(12).Copy Range("C13")
            .Offset(1, 13).Resize(, 1).SpecialCells(12).Copy Range("D13")
            For i = 2 To eR
                If Left(Range("A" & i), 2) = "PN" Then
                    .Offset(1, 12).Resize(, 1).SpecialCells(12).Copy Range("E13")
                    .Offset(1, 14).Resize(, 1).SpecialCells(12).Copy Range("F13")
                Else
                    .Offset(1, 12).Resize(, 1).SpecialCells(12).Copy Range("G13")
                    .Offset(1, 14).Resize(, 1).SpecialCells(12).Copy Range("H13")
                End If
            Next
            .AutoFilter
        End With
    End If
End Sub

 

[concogia]

Em loay hoay mãi mà vẫn không xử lý được code lọc sổ chi tiết này. Giờ em đưa bài lên đây nhờ các AC xem và hoàn thiện dùm em nhé!

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim eR
Dim i As Long
Set eR = s1.Range("A3000").End(3)
Application.ScreenUpdating = False
On Error Resume Next
If Target.Address = "$D$6" Then
Range("A13:J30000").Clear
With s1.Range(s1.[A1], s1.[A30000].End(3)).Offset(1).Resize(, 16)
.AutoFilter 2, ">=" & CLng(Range("K1").Value), 1, "<=" & CLng(Range("K2").Value)
.AutoFilter 10, Range("D6")
.Offset(1, -1).Resize(, 1).SpecialCells(12).Copy Range("A13") 'Sao dong nay van chua dung ah?
.Offset(1, 8).Resize(, 1).SpecialCells(12).Copy Range("C13")
.Offset(1, 13).Resize(, 1).SpecialCells(12).Copy Range("D13")
For i = 2 To eR
If Left(Range("A" & i), 2) = "PN" Then
.Offset(1, 12).Resize(, 1).SpecialCells(12).Copy Range("E13")
.Offset(1, 14).Resize(, 1).SpecialCells(12).Copy Range("F13")
Else
.Offset(1, 12).Resize(, 1).SpecialCells(12).Copy Range("G13")
.Offset(1, 14).Resize(, 1).SpecialCells(12).Copy Range("H13")
End If
Next
.AutoFilter
End With
End If
End Sub

Chưa đọc kỹ, thấy sơ sơ thế này
.Offset(1, -1). Đang ở cột A, chạy ngược về bên trái 1 cột làm sao được ......hả Trời
For i = 2 To eR : eR đâu phải là số mà cho biến i chạy tới nó ...hả Trời
Thân

 

[NH_DK]

To @concogia

Private Sub Worksheet_Change(ByVal Target As Range)    
    Application.ScreenUpdating = False
    On Error Resume Next
    If Target.Address = "$D$6" Then
        Range("A13:J30000").Clear
        With s1.Range(s1.[A1], s1.[A30000].End(3)).Offset(1).Resize(, 16)
            .AutoFilter 2, ">=" & CLng(Range("K1").Value), 1, "<=" & CLng(Range("K2").Value)
            .AutoFilter 10, Range("D6")
            .Offset(1, 0).Resize(, 2).SpecialCells(12).Copy Range("A13") 'Sao dong nay van chua dung ah?
            .Offset(1, 8).Resize(, 1).SpecialCells(12).Copy Range("C13")
            .Offset(1, 13).Resize(, 1).SpecialCells(12).Copy Range("D13")
            If Left(Range("A" & i), 2) = "PN" Then
                .Offset(1, 12).Resize(, 1).SpecialCells(12).Copy Range("E13")
                .Offset(1, 14).Resize(, 1).SpecialCells(12).Copy Range("F13")
            Else
                .Offset(1, 12).Resize(, 1).SpecialCells(12).Copy Range("G13")
                .Offset(1, 14).Resize(, 1).SpecialCells(12).Copy Range("H13")
            End If
            .AutoFilter
        End With
    End If
End Sub

Nhưng còn đoạn này em vẫn không làm được.

If Left(Range("A" & i), 2) = "PN" Then
                .Offset(1, 12).Resize(, 1).SpecialCells(12).Copy Range("E13")
                .Offset(1, 14).Resize(, 1).SpecialCells(12).Copy Range("F13")
            Else
                .Offset(1, 12).Resize(, 1).SpecialCells(12).Copy Range("G13")
                .Offset(1, 14).Resize(, 1).SpecialCells(12).Copy Range("H13")
            End If

concogia và AC làm dùm em với ah!