Lọc dữ liệu theo điều kiện và trả kết quả ở sheet khác

Liên hệ QC
T

thaiphaml2t

Thành viên mới
Tham gia
30/11/17
Bài viết
2
Được thích
0
Giới tính
Nam
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 ạ.
 

File đính kèm

  • LOCNHOMKEY.xlsx
    10 KB · Đọc: 12
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
 

File đính kèm

  • LOCNHOMKEY.xlsm
    20 KB · Đọc: 8
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
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

  • LOCNHOMKEY.xlsm
    20.6 KB · Đọc: 10
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
Nhấp chuột vào đây để mở rộng...
Ý 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.
 
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.
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộng...
ok bác được rồi ạ. Cảm ơn bác nhiều lắm :D
Bài đã được tự động gộp:

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
Nhấp chuột vào đây để mở rộng...
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?
 
Lần chỉnh sửa cuối:
kedochanh2201 đã viết:
ok bác được rồi ạ. Cảm ơn bác nhiều lắm :D
Bài đã được tự động gộp:


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?
Nhấp chuột vào đây để mở rộng...
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?
Nhấp chuột vào đây để mở rộng...
mình chưa hiểu, bạn giải thích & cho ví dụ rõ hơn
Thân
 
kedochanh2201 đã viết:
ok bác được rồi ạ. Cảm ơn bác nhiều lắm :D
Bài đã được tự động gộp:


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?
Nhấp chuột vào đây để mở rộng...
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 :D
 
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
Nhấp chuột vào đây để mở rộng...
à chắc chưa cần đầu :))) cảm ơn bác nhá!
Bài đã được tự động gộp:

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 :D
Nhấp chuột vào đây để mở rộng...
ok a. Lần sau e rút kinh nghiệm
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

N
Hàm if, lọc dữ liệu trùng
Trả lời
7
Đọc
6K
HUONGHCKT
H
tby211
Lỗi 1004 vba khi tách file trắc nghiệm sang excel
Trả lời
1
Đọc
28
HUONGHCKT
H
T
di chuyển đến ô kết quả của hàm
2
Trả lời
21
Đọc
7K
hoangtuan.net
hoangtuan.net
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
7
Đọc
154
HUONGHCKT
H
P
HÀM SUBTOTAL BỊ #VALUE
Trả lời
2
Đọc
53
phantuancauvan
P
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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

Back
Top Bottom