[Cần trợ giúp] Filter dữ liệu theo điều kiện (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Datcdt2k9

Thành viên hoạt động
Tham gia
27/12/19
Bài viết
109
Được thích
11
Em cần lọc dữ liệu theo 2 điều kiện:
Trong dải cột B
và cột D Không Có N/A => lấy dải cuối trong Cột C ( trong ví dụ vq1903ofa013)
Có N/A => Bỏ qua
Mong mọi người trong diễn đàn giúp đỡ em ạ. Em xin cảm ơn!!!1607494448117.png
 

File đính kèm

Lần chỉnh sửa cuối:
Vẫn chưa hiểu đề bài mấy. Cột C làm gì có giá trị nào #NA nhỉ
 
E đã update lại rồi ạ
Thử code này xem:
Mã:
Option Explicit
Sub NTKTNN()
Dim sArr(), DelArr(), Dic As Object, dArr(), I&, J&, Lr&, R&
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
    Lr = .Cells(Rows.Count, "B").End(xlUp).Row
    sArr = .Range("B2:C" & Lr).Value
    DelArr = .Range("G2:G" & Lr).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R, 1 To 1)
    For I = 1 To R: Dic.Item(DelArr(I, 1)) = "": Next
    For I = 1 To R
        If I = 1 Then
            If Dic.exists(sArr(I, 2)) Then
                dArr(I, 1) = sArr(I, 2)
            End If
        Else
            If sArr(I, 1) = sArr(I - 1, 1) Then
                dArr(I - 1, 1) = ""
                If Not Dic.exists(sArr(I, 2)) Then J = J + 1
            Else
                If J > 0 Then dArr(I - 1, 1) = "": J = 0
                If Not Dic.exists(sArr(I, 2)) Then
                    J = J + 1
                Else
                    dArr(I, 1) = sArr(I, 2)
                End If
            End If
            If J = 0 Then dArr(I, 1) = sArr(I, 2)
        End If
    Next
    .Range("E2").Resize(R) = dArr
End With
End Sub
 
Thử code này xem:
Mã:
Option Explicit
Sub NTKTNN()
Dim sArr(), DelArr(), Dic As Object, dArr(), I&, J&, Lr&, R&
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
    Lr = .Cells(Rows.Count, "B").End(xlUp).Row
    sArr = .Range("B2:C" & Lr).Value
    DelArr = .Range("G2:G" & Lr).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R, 1 To 1)
    For I = 1 To R: Dic.Item(DelArr(I, 1)) = "": Next
    For I = 1 To R
        If I = 1 Then
            If Dic.exists(sArr(I, 2)) Then
                dArr(I, 1) = sArr(I, 2)
            End If
        Else
            If sArr(I, 1) = sArr(I - 1, 1) Then
                dArr(I - 1, 1) = ""
                If Not Dic.exists(sArr(I, 2)) Then J = J + 1
            Else
                If J > 0 Then dArr(I - 1, 1) = "": J = 0
                If Not Dic.exists(sArr(I, 2)) Then
                    J = J + 1
                Else
                    dArr(I, 1) = sArr(I, 2)
                End If
            End If
            If J = 0 Then dArr(I, 1) = sArr(I, 2)
        End If
    Next
    .Range("E2").Resize(R) = dArr
End With
End Sub
Em cảm ơn , em đã làm được rồi ạ
 
Lần chỉnh sửa cuối:
Em cảm ơn , em đã làm được rồi ạ
em thấy code này muốn ra kq thì phụ thuộc vào cột G2:G, a sửa giúp e chỉ phụ thuôc vào cột từ A-> E với ạ, coi như bảng dữ liệu của e chỉ từ cột A-> cột E
View attachment 250919
Bài đã được tự động gộp:

Thử code này xem:
Mã:
Option Explicit
Sub NTKTNN()
Dim sArr(), DelArr(), Dic As Object, dArr(), I&, J&, Lr&, R&
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
    Lr = .Cells(Rows.Count, "B").End(xlUp).Row
    sArr = .Range("B2:C" & Lr).Value
    DelArr = .Range("G2:G" & Lr).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R, 1 To 1)
    For I = 1 To R: Dic.Item(DelArr(I, 1)) = "": Next
    For I = 1 To R
        If I = 1 Then
            If Dic.exists(sArr(I, 2)) Then
                dArr(I, 1) = sArr(I, 2)
            End If
        Else
            If sArr(I, 1) = sArr(I - 1, 1) Then
                dArr(I - 1, 1) = ""
                If Not Dic.exists(sArr(I, 2)) Then J = J + 1
            Else
                If J > 0 Then dArr(I - 1, 1) = "": J = 0
                If Not Dic.exists(sArr(I, 2)) Then
                    J = J + 1
                Else
                    dArr(I, 1) = sArr(I, 2)
                End If
            End If
            If J = 0 Then dArr(I, 1) = sArr(I, 2)
        End If
    Next
    .Range("E2").Resize(R) = dArr
End With
End Sub
em thấy code này muốn ra kết quả, thì phụ thuộc vào cột G2:G, anh sửa giúp em chỉ phụ thuôc vào cột từ A-> E với ạ, coi như bảng dữ liệu của em chỉ từ cột A-> cột E anh ạ
1607512728042.png
 
Lần chỉnh sửa cuối:
e thấy code này muốn ra kq thì phụ thuộc vào cột G2:G, a sửa giúp e chỉ phụ thuôc vào cột từ A-> E với ạ, coi như bảng dữ liệu của e chỉ từ cột A-> cột E
View attachment 250919
Bài đã được tự động gộp:


e thấy code này muốn ra kq thì phụ thuộc vào cột G2:G, a sửa giúp e chỉ phụ thuôc vào cột từ A-> E với ạ, coi như bảng dữ liệu của e chỉ từ cột A-> cột E a ạ
View attachment 250920
Bạn có biết cột D cũng chỉ là tham chiếu tới cột G không?
 
Bạn có biết cột D cũng chỉ là tham chiếu tới cột G không?
E biết, nhưng mà a giúp e sửa code data chỉ từ cột A tới cột E mà ra kq như e cần vs ạ
Bài đã được tự động gộp:

E biết, nhưng mà a giúp e sửa code data chỉ từ cột A tới cột E mà ra kq như e cần vs ạ
Vì data của em có thể phát sinh vlookup tham chiếu từ sheet khác ( file khác ) nên em không muốn phụ thuộc vào cái đó anh ạ
 
Lần chỉnh sửa cuối:
Sự trong sáng của Tiếng Việt ở bài này không biết đi công tác ở đâu ấy nhỉ.
 
E biết, nhưng mà a giúp e sửa code data chỉ từ cột A tới cột E mà ra kq như e cần vs ạ
Bài đã được tự động gộp:


Vì data của em có thể phát sinh vlookup tham chiếu từ sheet khác ( file khác ) nên em không muốn phụ thuộc vào cái đó anh ạ
Thử lại code này xem
Mã:
Option Explicit
Sub NTKTNN()
Dim sArr(), Dic As Object, dArr(), I&, J&, Lr&, R&
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
    Lr = .Cells(Rows.Count, "B").End(xlUp).Row
    sArr = .Range("B2:D" & Lr).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R, 1 To 1)
    For I = 1 To R
        If Not IsError(sArr(I, 3)) Then
            Dic.Item(sArr(I, 2)) = ""
        End If
    Next
    For I = 1 To R
        If I = 1 Then
            If Dic.exists(sArr(I, 2)) Then
                dArr(I, 1) = sArr(I, 2)
            End If
        Else
            If sArr(I, 1) = sArr(I - 1, 1) Then
                dArr(I - 1, 1) = ""
                If Not Dic.exists(sArr(I, 2)) Then J = J + 1
            Else
                If J > 0 Then dArr(I - 1, 1) = "": J = 0
                If Not Dic.exists(sArr(I, 2)) Then
                    J = J + 1
                Else
                    dArr(I, 1) = sArr(I, 2)
                End If
            End If
            If J = 0 Then dArr(I, 1) = sArr(I, 2)
        End If
    Next
    .Range("E2").Resize(R) = dArr
End With
End Sub
 
Thử lại code này xem
Mã:
Option Explicit
Sub NTKTNN()
Dim sArr(), Dic As Object, dArr(), I&, J&, Lr&, R&
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
    Lr = .Cells(Rows.Count, "B").End(xlUp).Row
    sArr = .Range("B2:D" & Lr).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R, 1 To 1)
    For I = 1 To R
        If Not IsError(sArr(I, 3)) Then
            Dic.Item(sArr(I, 2)) = ""
        End If
    Next
    For I = 1 To R
        If I = 1 Then
            If Dic.exists(sArr(I, 2)) Then
                dArr(I, 1) = sArr(I, 2)
            End If
        Else
            If sArr(I, 1) = sArr(I - 1, 1) Then
                dArr(I - 1, 1) = ""
                If Not Dic.exists(sArr(I, 2)) Then J = J + 1
            Else
                If J > 0 Then dArr(I - 1, 1) = "": J = 0
                If Not Dic.exists(sArr(I, 2)) Then
                    J = J + 1
                Else
                    dArr(I, 1) = sArr(I, 2)
                End If
            End If
            If J = 0 Then dArr(I, 1) = sArr(I, 2)
        End If
    Next
    .Range("E2").Resize(R) = dArr
End With
End Sub
Vâng, em thử luôn anh ạ
 
Vâng, em thử luôn anh ạ
Vậy bạn thử luôn cái này coi sao

PHP:
Option Explicit

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, R As Long, Rws As Long, Txt As String
    sArr = Range("B2", Range("B10000").End(xlUp)).Resize(, 3).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
    For I = R To 1 Step -1
        If sArr(I, 1) <> Txt Then
            Rws = I
            Txt = sArr(I, 1)
            dArr(Rws, 1) = sArr(I, 2)
        End If
        If IsError(sArr(I, 3)) Then dArr(Rws, 1) = Empty
    Next I
Range("E2").Resize(R) = dArr
End Sub
Mã:
 
Lần chỉnh sửa cuối:
Vậy bạn thử luôn cái này coi sao

PHP:
Option Explicit

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, R As Long, Rws As Long, Txt As String
    sArr = Range("B2", Range("B10000").End(xlUp)).Resize(, 3).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
    For I = R To 1 Step -1
        If sArr(I, 1) <> Txt Then
            Rws = I
            Txt = sArr(I, 1)
            dArr(Rws, 1) = sArr(I, 2)
        End If
        If IsError(sArr(I, 3)) Then dArr(Rws, 1) = Empty
    Next I
Range("E2").Resize(R) = dArr
End Sub
Mã:
Vâng, em cảm ơn mọi người, em làm được rồi ạ
 
Web KT

Bài viết mới nhất

Back
Top Bottom