Lọc dữ liệu theo điều kiện và trả kết quả ở sheet khác (2 người xem)

thaiphaml2t · 3/4/19

Lọc dữ liệu theo điều kiện và trả kết quả ở sheet khác
Sheet tonghop là nội dung tổng hợp của em. Bao gồm 2 cột: Mã sản phẩm và tiêu đề
Sheet 2 là Key e cần lọc, những dòng nào có key trong list đó thì cắt qua bên sheet ketqua 2 cột luôn ạ.

Bác nào đã từng làm file như vậy giúp em với nha! Em xin cảm ơn ạ.

leonguyenz · 3/4/19

Tham khảo code sau:

Mã:

Sub Button2_Click()
Dim sRng As Range, cRng As Range, iR As Long, jR As Long, kR As Long, rArr()
Set sRng = Sheet1.Range("A1:B" & Sheet1.Range("A65535").End(xlUp).Row)
Set cRng = Sheet2.Range("A1:A" & Sheet2.Range("A65535").End(xlUp).Row)
ReDim rArr(1 To sRng.Rows.Count * cRng.Rows.Count, 1 To 2)
For iR = 1 To cRng.Rows.Count
    For jR = 1 To sRng.Rows.Count
        If sRng(jR, 2) Like "*" & cRng(iR) & "*" Then
            kR = kR + 1
            rArr(kR, 1) = sRng(jR, 1).Value
            rArr(kR, 2) = sRng(jR, 2).Value
        End If
    Next jR
Next iR
If kR Then
    With Sheet3
        .Columns("A:B").ClearContents
        .Range("A1").Resize(kR - 1, 2) = rArr
        .Columns("A:B").AutoFit
        .Activate
    End With
End If
End Sub

thaiphaml2t · 3/4/19

leonguyenz đã viết:

Tham khảo code sau:

Mã:

Sub Button2_Click()
Dim sRng As Range, cRng As Range, iR As Long, jR As Long, kR As Long, rArr()
Set sRng = Sheet1.Range("A1:B" & Sheet1.Range("A65535").End(xlUp).Row)
Set cRng = Sheet2.Range("A1:A" & Sheet2.Range("A65535").End(xlUp).Row)
ReDim rArr(1 To sRng.Rows.Count * cRng.Rows.Count, 1 To 2)
For iR = 1 To cRng.Rows.Count
    For jR = 1 To sRng.Rows.Count
        If sRng(jR, 2) Like "*" & cRng(iR) & "*" Then
            kR = kR + 1
            rArr(kR, 1) = sRng(jR, 1).Value
            rArr(kR, 2) = sRng(jR, 2).Value
        End If
    Next jR
Next iR
If kR Then
    With Sheet3
        .Columns("A:B").ClearContents
        .Range("A1").Resize(kR - 1, 2) = rArr
        .Columns("A:B").AutoFit
        .Activate
    End With
End If
End Sub

Em thử rồi mà nó cắt cả 27 cột qua kết quả

nhòm key có 4 từ à, cắt không nhiều dòng như vậy đâu bác

leonguyenz · 3/4/19

thaiphaml2t đã viết:
Em thử rồi mà nó cắt cả 27 cột qua kết quả nhòm key có 4 từ à, cắt không nhiều dòng như vậy đâu bác

Chưa hiểu yêu cầu của bạn theo Key như thế nào, thử lọc không trùng xem:

Mã:

Sub Button2_Click()
Dim sRng As Range, cRng As Range, iR As Long, jR As Long, kR As Long, rArr()
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set sRng = Sheet1.Range("A1:B" & Sheet1.Range("A65535").End(xlUp).Row)
Set cRng = Sheet2.Range("A1:A" & Sheet2.Range("A65535").End(xlUp).Row)
ReDim rArr(1 To sRng.Rows.Count * cRng.Rows.Count, 1 To 2)
For iR = 1 To cRng.Rows.Count
    For jR = 1 To sRng.Rows.Count
        If sRng(jR, 2) Like "*" & cRng(iR) & "*" Then
            If Not Dic.Exists(sRng(jR, 2)) Then
                kR = kR + 1
                Dic.Add sRng(jR, 2), k
                rArr(kR, 1) = sRng(jR, 1).Value
                rArr(kR, 2) = sRng(jR, 2).Value
            End If
        End If
    Next jR
Next iR
If kR Then
    With Sheet3
        .Columns("A:B").ClearContents
        .Range("A1").Resize(kR - 1, 2) = rArr
        .Columns("A:B").AutoFit
        .Activate
    End With
End If
End Sub

kedochanh2201 · 3/4/19

leonguyenz đã viết:

Chưa hiểu yêu cầu của bạn theo Key như thế nào, thử lọc không trùng xem:

Mã:

Sub Button2_Click()
Dim sRng As Range, cRng As Range, iR As Long, jR As Long, kR As Long, rArr()
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set sRng = Sheet1.Range("A1:B" & Sheet1.Range("A65535").End(xlUp).Row)
Set cRng = Sheet2.Range("A1:A" & Sheet2.Range("A65535").End(xlUp).Row)
ReDim rArr(1 To sRng.Rows.Count * cRng.Rows.Count, 1 To 2)
For iR = 1 To cRng.Rows.Count
    For jR = 1 To sRng.Rows.Count
        If sRng(jR, 2) Like "*" & cRng(iR) & "*" Then
            If Not Dic.Exists(sRng(jR, 2)) Then
                kR = kR + 1
                Dic.Add sRng(jR, 2), k
                rArr(kR, 1) = sRng(jR, 1).Value
                rArr(kR, 2) = sRng(jR, 2).Value
            End If
        End If
    Next jR
Next iR
If kR Then
    With Sheet3
        .Columns("A:B").ClearContents
        .Range("A1").Resize(kR - 1, 2) = rArr
        .Columns("A:B").AutoFit
        .Activate
    End With
End If
End Sub

Ý là Sheet 1 là data tonghop, sheet2 là list key có 4 key. Làm sao để tìm kiếm những dòng có 4 key đó ở bên data tonghop trả bên sheet ketqua á bác.

concogia · 3/4/19

kedochanh2201 đã viết:
Ý là Sheet 1 là data tonghop, sheet2 là list key có 4 key. Làm sao để tìm kiếm những dòng có 4 key đó ở bên data tonghop trả bên sheet ketqua á bác.

Hình như kiếm Key ở cột sheet "Tonghop", bạn thử code này:

Mã:

Public Sub Loc()
    Dim Vung, Dk, Kq, I, J, K
    Vung = Sheets("Tonghop").Range(Sheets("Tonghop").[A1], Sheets("Tonghop").[A5000].End(xlUp)).Resize(, 2)
    Dk = Sheets("Keycanloc").Range(Sheets("Keycanloc").[A1], Sheets("Keycanloc").[A50].End(xlUp))
    ReDim Kq(1 To UBound(Vung), 1 To 2)
        For I = 1 To UBound(Vung)
            For J = 1 To UBound(Dk)
                If InStr(Vung(I, 2), Dk(J, 1)) Then
                    K = K + 1
                    Kq(K, 1) = Vung(I, 1): Kq(K, 2) = Vung(I, 2): Exit For
                End If
            Next J
        Next I
    Sheets("Ketqua").[A1:B500].ClearContents
    Sheets("Ketqua").[A1].Resize(K, 2) = Kq
End Sub

Thân

kedochanh2201 · 3/4/19

concogia đã viết:

Hình như kiếm Key ở cột sheet "Tonghop", bạn thử code này:

Mã:

Public Sub Loc()
    Dim Vung, Dk, Kq, I, J, K
    Vung = Sheets("Tonghop").Range(Sheets("Tonghop").[A1], Sheets("Tonghop").[A5000].End(xlUp)).Resize(, 2)
    Dk = Sheets("Keycanloc").Range(Sheets("Keycanloc").[A1], Sheets("Keycanloc").[A50].End(xlUp))
    ReDim Kq(1 To UBound(Vung), 1 To 2)
        For I = 1 To UBound(Vung)
            For J = 1 To UBound(Dk)
                If InStr(Vung(I, 2), Dk(J, 1)) Then
                    K = K + 1
                    Kq(K, 1) = Vung(I, 1): Kq(K, 2) = Vung(I, 2): Exit For
                End If
            Next J
        Next I
    Sheets("Ketqua").[A1:B500].ClearContents
    Sheets("Ketqua").[A1].Resize(K, 2) = Kq
End Sub

Thân

ok bác được rồi ạ. Cảm ơn bác nhiều lắm

Bài đã được tự động gộp: 3/4/19

concogia đã viết:

Hình như kiếm Key ở cột sheet "Tonghop", bạn thử code này:

Mã:

Public Sub Loc()
    Dim Vung, Dk, Kq, I, J, K
    Vung = Sheets("Tonghop").Range(Sheets("Tonghop").[A1], Sheets("Tonghop").[A5000].End(xlUp)).Resize(, 2)
    Dk = Sheets("Keycanloc").Range(Sheets("Keycanloc").[A1], Sheets("Keycanloc").[A50].End(xlUp))
    ReDim Kq(1 To UBound(Vung), 1 To 2)
        For I = 1 To UBound(Vung)
            For J = 1 To UBound(Dk)
                If InStr(Vung(I, 2), Dk(J, 1)) Then
                    K = K + 1
                    Kq(K, 1) = Vung(I, 1): Kq(K, 2) = Vung(I, 2): Exit For
                End If
            Next J
        Next I
    Sheets("Ketqua").[A1:B500].ClearContents
    Sheets("Ketqua").[A1].Resize(K, 2) = Kq
End Sub

Thân

Giả sử trong TH lọc nhóm key này e có dạng text thì fix đoạn này sao bác nhỉ?
Dk = Sheets("Keycanloc").Range(Sheets("Keycanloc").[A1], Sheets("Keycanloc").[A50].End(xlUp))
cái điều kiện này lấy sheet2 ví dụ e muốn lấy key1, key2, key3, key4,.... được không bác?

concogia · 3/4/19

kedochanh2201 đã viết:
ok bác được rồi ạ. Cảm ơn bác nhiều lắm

Bài đã được tự động gộp: 3/4/19

Giả sử trong TH lọc nhóm key này e có dạng text thì fix đoạn này sao bác nhỉ?
Dk = Sheets("Keycanloc").Range(Sheets("Keycanloc").[A1], Sheets("Keycanloc").[A50].End(xlUp))
cái điều kiện này lấy sheet2 ví dụ e muốn lấy key1, key2, key3, key4,.... được không bác?

Thật ra mình chỉ viết theo yêu cầu và dữ liệu trong bài của bạn thôi, còn cái này:

cái điều kiện này lấy sheet2 ví dụ e muốn lấy key1, key2, key3, key4,.... được không bác?

mình chưa hiểu, bạn giải thích & cho ví dụ rõ hơn
Thân

LamNA · 3/4/19

kedochanh2201 đã viết:
ok bác được rồi ạ. Cảm ơn bác nhiều lắm

Bài đã được tự động gộp: 3/4/19

Giả sử trong TH lọc nhóm key này e có dạng text thì fix đoạn này sao bác nhỉ?
Dk = Sheets("Keycanloc").Range(Sheets("Keycanloc").[A1], Sheets("Keycanloc").[A50].End(xlUp))
cái điều kiện này lấy sheet2 ví dụ e muốn lấy key1, key2, key3, key4,.... được không bác?

Bạn nên có mẫu file thật và xóa đi dữ liệu không cần thiết thì anh chị diễn đàn hỗ trợ nhanh cho bạn hơn là cứ bốc ghép.
Ps: Một thanh niên thời mới tham gia diễn đàn có kinh nghiệm cho hay

kedochanh2201 · 3/4/19

concogia đã viết:
Thật ra mình chỉ viết theo yêu cầu và dữ liệu trong bài của bạn thôi, còn cái này:

mình chưa hiểu, bạn giải thích & cho ví dụ rõ hơn
Thân

à chắc chưa cần đầu

)) cảm ơn bác nhá!

Bài đã được tự động gộp: 3/4/19

LamNA đã viết:
Bạn nên có mẫu file thật và xóa đi dữ liệu không cần thiết thì anh chị diễn đàn hỗ trợ nhanh cho bạn hơn là cứ bốc ghép.
Ps: Một thanh niên thời mới tham gia diễn đàn có kinh nghiệm cho hay

ok a. Lần sau e rút kinh nghiệm

Lọc dữ liệu theo điều kiện và trả kết quả ở sheet khác (2 người xem)

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

thaiphaml2t

Thành viên mới

File đính kèm

leonguyenz

Thành viên gạo cội

File đính kèm

thaiphaml2t

Thành viên mới

leonguyenz

Thành viên gạo cội

File đính kèm

kedochanh2201

Thành viên mới

concogia

Gội rồi mới Cạo

kedochanh2201

Thành viên mới

concogia

Gội rồi mới Cạo

LamNA

Thành viên tích cực

kedochanh2201

Thành viên mới

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian