Lọc 3 dòng liên tiếp (5 người xem)

[nguyenvanthao2002]

Em nhờ các anh chị giúp em lọc lấy dữ liệu 3 dòng liên tiếp như file đính kèm. Em xin cám ơn

 

[thepdaoson]

Đây là file có virus X97M/Laroux.f

 

[Tình nghĩa giang hồ]

Hồi tối mình tải thử thấy cũng báo virus

 

[Phuocam]

Hahaha, tôi tải cũng được cảnh báo!

.

 

[nguyenvanthao2002]

Đây là file có virus X97M/Laroux.f

em gửi lại rồi ạ.

 

[nguyenvanthao2002]

Hồi tối mình tải thử thấy cũng báo virus

Em đính kèm lại rồi ạ.

 

[BuiQuangThuan]

Em đính kèm lại rồi ạ.

Lần 1 dính nên lần 2 rén

 

[Hoàng Tuấn 868]

Lần 1 dính nên lần 2 rén

....... ....... ........... ................. .....................................

 

[Ronaldinho7]

Em nhờ các anh chị giúp em lọc lấy dữ liệu 3 dòng liên tiếp như file đính kèm. Em xin cám ơn

Bạn thử code xem chạy được không?

Sub test()
Dim Arr(), Res(), Lr As Long, i As Long, j As Long, k As Long, b As Long
With Sheet1
    Lr = .Range("A" & Rows.Count).End(xlUp).Row
    Arr = .Range("A2:B" & Lr + 3).Value
    ReDim Res(1 To UBound(Arr), 1 To 2)
    For i = 1 To UBound(Arr)
        If InStr(Arr(i, 1), "M15") > 0 And InStr(Arr(i + 1, 1), "ENTRY") > 0 And InStr(Arr(i + 2, 1), "SL") > 0 Then
            k = k + 1
            For b = 1 To 2
                Res(k, b) = Arr(i, b)
                Res(k + 1, b) = Arr(i + 1, b)
                Res(k + 2, b) = Arr(i + 2, b)
            Next b
            k = k + 2
        End If
        If i = Lr Then Exit For
    Next i
    If k Then
    .Range("I18").Resize(UBound(Arr), 2).Value = Res
    End If
End With
End Sub

 

[nguyenvanthao2002]

Bạn thử code xem chạy được không?

Sub test()
Dim Arr(), Res(), Lr As Long, i As Long, j As Long, k As Long, b As Long
With Sheet1
    Lr = .Range("A" & Rows.Count).End(xlUp).Row
    Arr = .Range("A2:B" & Lr + 3).Value
    ReDim Res(1 To UBound(Arr), 1 To 2)
    For i = 1 To UBound(Arr)
        If InStr(Arr(i, 1), "M15") > 0 And InStr(Arr(i + 1, 1), "ENTRY") > 0 And InStr(Arr(i + 2, 1), "SL") > 0 Then
            k = k + 1
            For b = 1 To 2
                Res(k, b) = Arr(i, b)
                Res(k + 1, b) = Arr(i + 1, b)
                Res(k + 2, b) = Arr(i + 2, b)
            Next b
            k = k + 2
        End If
        If i = Lr Then Exit For
    Next i
    If k Then
    .Range("I18").Resize(UBound(Arr), 2).Value = Res
    End If
End With
End Sub

Em cám ơn Anh nhiều.