[Giúp đỡ trích lọc dữ liệu theo điều kiện logic] VBA

[vncws99]

Em gặp phải bài tập về trích lọc dữ liệu theo điều kiện logic khá phức tạp quá, em làm 1 lúc thấy rối quá , data và đề bài rất dài nhưng e tóm lại ngắn như trong file , anh chị xem giúp đỡ em vs được không ạ ?

Cảm ơn anh chị nhiều.

 

[snow25]

Em gặp phải bài tập về trích lọc dữ liệu theo điều kiện logic khá phức tạp quá, em làm 1 lúc thấy rối quá , data và đề bài rất dài nhưng e tóm lại ngắn như trong file , anh chị xem giúp đỡ em vs được không ạ ?

Cảm ơn anh chị nhiều.

Bạn thử cái này.

Sub linhtinh()
    Dim arr, kq, i As Long, dk As String, s1 As String, s As String, a As Long
    With Sheets("Query")
         dk = .Range("e4").Value
         .Range("B7:C1000").ClearContents
    End With
    With Sheets("dieukien")
         arr = .Range("D3:E17").Value
         ReDim kq(1 To UBound(arr), 1 To 2)
         For i = 1 To UBound(arr)
             s1 = s1 & "#" & arr(i, 1)
             If dk = arr(i, 1) Then
                s = s & "#" & arr(i, 2)
             End If
             If dk = arr(i, 2) Then
                a = a + 1
                kq(a, 1) = a
                kq(a, 2) = arr(i, 1)
             End If
         Next i
         For i = 1 To UBound(arr)
           If dk <> arr(i, 1) Then
             If InStr(1, s, arr(i, 2)) Then
                a = a + 1
                kq(a, 1) = a
                kq(a, 2) = arr(i, 1)
             End If
           Else
              If InStr(1, s1, arr(i, 2)) Then
                 a = a + 1
                 kq(a, 1) = a
                 kq(a, 2) = arr(i, 2)
              End If
           End If
         Next i
   End With
   With Sheets("Query")
       If a Then .Range("b7:C7").Resize(a).Value = kq
   End With
End Sub

 

[vncws99]

Cảm ơn bạn nhiều, bạn có mail không ấy, mình muốn hỏi vài cái của bài trên với