Nhờ giúp em Code lọc dữ liệu theo tên kho? (1 người xem)

[hitlecp]

Chào anh, chị!
Nhờ các anh, chị chỉ giúp em Code lọc dữ liệu theo tên kho, số liệu nhảy theo tương ứng với kho đó. Do dữ liệu bên sheet B012 rất nhiều vài chục ngàn dòng mà dùng công thức thì chạy không nổi. Nên nhờ anh, chị chỉ giúp em Code lọc ạ.
(Em có kèm theo file)
Em cám ơn!

 

[SA_DQ]

Macro sự kiện ở trang 'TonB012" của bạn đây:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rws As Long, W As Integer, J As Long, Cot As Integer
Dim Arr()
Const Col As Integer = 16
If Not Intersect(Target, [B2]) Is Nothing Then
    With Sheets("B012")
        Rws = .[B2].CurrentRegion.Rows.Count
        Arr() = .[A2].Resize(Rws, Col).Value
        ReDim dArr(1 To Rws, 1 To Col)
    End With
    For J = 1 To UBound(Arr())
        If Arr(J, 1) = Target.Value Then
            W = W + 1
            For Cot = 1 To 2
                dArr(W, Cot) = Arr(J, Cot):     dArr(W, Cot + 2) = Arr(J, Cot + 4)
            Next Cot
            For Cot = 5 To 7
                dArr(W, Cot) = Arr(J, Cot + 5):     dArr(W, Cot + 3) = Arr(J, Cot + 9)
            Next Cot
        End If
    Next J
    [A5].Resize(W + 9, Col).Value = dArr()
End If
End Sub

Chúc vui vẻ nhân dịp xuân sang!

 

[VetMini]

Lý do tại sao phải cốt kiếc.
Chức năng Filter và SubTotal nó đâu có sợ vài chục ngàn dòng.

Nếu nhiều hơn nữa thì bỏ nó vào Data Model, sẽ có thêm một mớ hàm thống kê tha hồ mà dùng.

Thật khó hiểu, người ta cứ nói chuyện dữ liệu hàng trăm ngàn, hàng triệu dòng mà không bao giờ chịu tìm hiểu để thấy rằng Microsoft (dân GPE gọi là anh Biêu) đã ra cái Data Model để đáp ứng với dữ liệu khủng.

 

[hitlecp]

Macro sự kiện ở trang 'TonB012" của bạn đây:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rws As Long, W As Integer, J As Long, Cot As Integer
Dim Arr()
Const Col As Integer = 16
If Not Intersect(Target, [B2]) Is Nothing Then
    With Sheets("B012")
        Rws = .[B2].CurrentRegion.Rows.Count
        Arr() = .[A2].Resize(Rws, Col).Value
        ReDim dArr(1 To Rws, 1 To Col)
    End With
    For J = 1 To UBound(Arr())
        If Arr(J, 1) = Target.Value Then
            W = W + 1
            For Cot = 1 To 2
                dArr(W, Cot) = Arr(J, Cot):     dArr(W, Cot + 2) = Arr(J, Cot + 4)
            Next Cot
            For Cot = 5 To 7
                dArr(W, Cot) = Arr(J, Cot + 5):     dArr(W, Cot + 3) = Arr(J, Cot + 9)
            Next Cot
        End If
    Next J
    [A5].Resize(W + 9, Col).Value = dArr()
End If
End Sub

Chúc vui vẻ nhân dịp xuân sang!

Macro sự kiện ở trang 'TonB012" của bạn đây:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rws As Long, W As Integer, J As Long, Cot As Integer
Dim Arr()
Const Col As Integer = 16
If Not Intersect(Target, [B2]) Is Nothing Then
    With Sheets("B012")
        Rws = .[B2].CurrentRegion.Rows.Count
        Arr() = .[A2].Resize(Rws, Col).Value
        ReDim dArr(1 To Rws, 1 To Col)
    End With
    For J = 1 To UBound(Arr())
        If Arr(J, 1) = Target.Value Then
            W = W + 1
            For Cot = 1 To 2
                dArr(W, Cot) = Arr(J, Cot):     dArr(W, Cot + 2) = Arr(J, Cot + 4)
            Next Cot
            For Cot = 5 To 7
                dArr(W, Cot) = Arr(J, Cot + 5):     dArr(W, Cot + 3) = Arr(J, Cot + 9)
            Next Cot
        End If
    Next J
    [A5].Resize(W + 9, Col).Value = dArr()
End If
End Sub

Chúc vui vẻ nhân dịp xuân sang!

Em copy code vào báo lỗi. Chưa chạy được anh ạ (em gửi file kèm)

 

[SA_DQ]

Đó là macro sự kiện mà, bỏ nó vô trang 'TonB012' ý.


Mà đăng bài tại đây là sai đề mục rồi!

 

[hitlecp]

Đó là macro sự kiện mà, bỏ nó vô trang 'TonB012' ý.


Mà đăng bài tại đây là sai đề mục rồi!

Dạ, em cám ơn ạ