Code lọc dữ liệu, so sánh điều kiện mảng dữ liệu

[lengoc1490]

Chào các thầy cô và anh chị trong diễn đàn!
E có 1 file dữ liệu, ở sheet(Data) là dữ liệu copy từ nhiều sheet chi tiết.
E muốn lọc riêng phần vật tư phụ, với điều kiện Mã vật tư phụ ở cột B (trong sheet(data)) khác với Mã để so sánh nằm ở cột K:L (trong sheet(Data))
Trong code của e đang dùng mảng và toán tử like để so sánh, nhưng không ra kết quả.
Kính mong các thầy cô và anh chị hướng dẫn giúp e 1 code về mảng để lọc dữ liệu.
E xin chân thành cảm ơn!

 

[befaint]

lọc

Hôm trước đã gợi ý cách diễn đạt là:
- Nếu vật tư ở cột C là kính thì lấy màu sắc ở cột D tương ứng so sánh với cột L,
- Nếu vật tư ở cột C không phải là kính thì lấy mấy ký tự (???) của mã ở cột B tương ứng so sánh với cột K,
- Kết quả trả về như nào thì viết minh họa sẵn!
?? Viết lại yêu cầu xem nào?

 

[Ba Tê]

Chào các thầy cô và anh chị trong diễn đàn!
E có 1 file dữ liệu, ở sheet(Data) là dữ liệu copy từ nhiều sheet chi tiết.
E muốn lọc riêng phần vật tư phụ, với điều kiện Mã vật tư phụ ở cột B (trong sheet(data)) khác với Mã để so sánh nằm ở cột K:L (trong sheet(Data))
Trong code của e đang dùng mảng và toán tử like để so sánh, nhưng không ra kết quả.
Kính mong các thầy cô và anh chị hướng dẫn giúp e 1 code về mảng để lọc dữ liệu.
E xin chân thành cảm ơn!

Hình như đã gặp vấn đề này ở bài nào đó rồi.

Option Explicit
Option Compare Text

Public Sub GPE()
Dim sArr(), tArr(1 To 100, 1 To 1), dArr(), DK As Boolean, Txt As String
Dim I As Long, J As Long, K As Long, R2 As Long, R1 As Long, N As Long
sArr = Sheets("Data").Range("K3", Sheets("Data").Range("K3").End(xlDown)).Resize(, 2).Value
    For J = 1 To 2
        For I = 1 To UBound(sArr)
            If sArr(I, J) <> Empty Then
                R1 = R1 + 1
                tArr(R1, 1) = sArr(I, J)
            End If
        Next I
    Next J
sArr = Sheets("Data").Range("A3", Sheets("Data").Range("A3").End(xlDown)).Resize(, 9).Value
    R2 = UBound(sArr)
    ReDim dArr(1 To R2, 1 To 9)
    For I = 1 To R2
        DK = False
        Txt = sArr(I, 2)
        For N = 1 To R1
            If Txt Like tArr(N, 1) & "*" Then
                DK = True: Exit For
            End If
        Next N
        If DK = False Then
            If sArr(I, 4) <> Empty Then
                Txt = sArr(I, 4)
                For N = 1 To R1
                    If Txt Like tArr(N, 1) & "*" Then
                        DK = True: Exit For
                    End If
                Next N
            End If
        End If
        If DK = False Then
            If sArr(I, 9) <> Empty Then
                K = K + 1
                For J = 1 To 9
                    dArr(K, J) = sArr(I, J)
                Next J
            End If
        End If
    Next I
Sheets("VatTuPhu").Range("A3").Resize(1000, 9).ClearContents
Sheets("VatTuPhu").Range("A3").Resize(K, 9) = dArr
End Sub

 

[lengoc1490]

Hình như đã gặp vấn đề này ở bài nào đó rồi.

Option Explicit
Option Compare Text

Public Sub GPE()
Dim sArr(), tArr(1 To 100, 1 To 1), dArr(), DK As Boolean, Txt As String
Dim I As Long, J As Long, K As Long, R2 As Long, R1 As Long, N As Long
sArr = Sheets("Data").Range("K3", Sheets("Data").Range("K3").End(xlDown)).Resize(, 2).Value
    For J = 1 To 2
        For I = 1 To UBound(sArr)
            If sArr(I, J) <> Empty Then
                R1 = R1 + 1
                tArr(R1, 1) = sArr(I, J)
            End If
        Next I
    Next J
sArr = Sheets("Data").Range("A3", Sheets("Data").Range("A3").End(xlDown)).Resize(, 9).Value
    R2 = UBound(sArr)
    ReDim dArr(1 To R2, 1 To 9)
    For I = 1 To R2
        DK = False
        Txt = sArr(I, 2)
        For N = 1 To R1
            If Txt Like tArr(N, 1) & "*" Then
                DK = True: Exit For
            End If
        Next N
        If DK = False Then
            If sArr(I, 4) <> Empty Then
                Txt = sArr(I, 4)
                For N = 1 To R1
                    If Txt Like tArr(N, 1) & "*" Then
                        DK = True: Exit For
                    End If
                Next N
            End If
        End If
        If DK = False Then
            If sArr(I, 9) <> Empty Then
                K = K + 1
                For J = 1 To 9
                    dArr(K, J) = sArr(I, J)
                Next J
            End If
        End If
    Next I
Sheets("VatTuPhu").Range("A3").Resize(1000, 9).ClearContents
Sheets("VatTuPhu").Range("A3").Resize(K, 9) = dArr
End Sub

Code của thầy rất hay. Em học hỏi được rất nhiều thứ.
Chúc thầy sức khỏe, thành công.
Em cảm ơn thầy rất nhiều!