请在师修改下代码,谢谢！

冷酷的云

Sub text()
    Dim arr, i%, wb As Workbook, rng As Range
    Set wb = GetObject(ThisWorkbook.Path & "\冻干.xls")
    arr = wb.Sheets(1).Range("A1").CurrentRegion
    With wb.Sheets(1)
    For i = 1 To UBound(arr)
        If InStr(arr(i, 6), [O3].Value) Then                                                   
        If InStr(arr(i, 8), [p3].Value) Then
        If InStr(arr(i, 10), [q3].Value) Then
        If InStr(arr(i, 12), [r3].Value) Then
            If rng Is Nothing Then
                Set rng = .Range(.Cells(i, 1), .Cells(i, 12))
            Else
                Set rng = Union(rng, .Range(.Cells(i, 1), .Cells(i, 12)))
            End If
         End If
         End If
         End If
         End If
    Next
    If Not rng Is Nothing Then rng.Copy Range("A2")
    End With
    wb.Close False

End Sub
请教大师：把条件同时为真时，修改为只要符合任意一个条件为真时，全部提取过来谢谢！

山菊花

Sub test()
    Dim arr, i%, wb As Workbook, rng As Range, Brr()
    Set wb = GetObject(ThisWorkbook.Path & "\冻干.xls")
    arr = wb.Sheets(1).Range("A1").CurrentRegion
    Brr = Range("o3:r3").Value
    With wb.Sheets(1)
        For i = 1 To UBound(arr)
            For j = 1 To 4
                If arr(i, j * 2 + 4) Like "*" & Brr(1, j) & "*" Then Exit For
            Next
            If j <= 4 Then
                If rng Is Nothing Then
                    Set rng = .Range(.Cells(i, 1), .Cells(i, 12))
                Else
                    Set rng = Union(rng, .Range(.Cells(i, 1), .Cells(i, 12)))
                End If
            End If
        Next
        If Not rng Is Nothing Then rng.Copy Range("A2")
    End With
    wb.Close False

End Sub