Dò tìm trong nhiều cột, lấy kết quả trong 1 cột? (1 người xem)

Liên hệ QC

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

Đa số bài viết OT đính kèm câu hỏi trong file như vậy , thì keyword hay tag để tìm kiếm không có thì sao đến lượt người khác tìm được vấn đề tương tự. Keyword và tag không chỉ nằm ở tiêu đề. Rõ ràng thì GPE là một diễn đàn chia sẻ cơ mà, suy ra bài viết mang nặng tính lợi ích cá nhân. Không tin OT hãy tìm kiếm như sau "Xin chào các bạn, như tiêu đề OT đã nêu" sẽ ra ngay và chính xác. Mong những bài viết sau OT diễn đạt rõ ràng hơn.
Cái tật xấu và dở nhất của tôi là lười biếng tải file nên không giúp được OT rồi. Thường thì tôi thích đọc trước nếu vui thì tải file.
 
Upvote 0

File đính kèm

Upvote 0
Xin chào các bạn,
Như tiêu đề OT đã nêu , nhờ các bạn giúp đỡ trường hợp của OT trong tập tin gửi kèm với ạ.
Bạn thử code này xem sao
Mã:
Option Explicit

Sub TimKiem()
Dim DM
Dim MaHang, Kieu, Chuoi
Dim Tenhang, Machung
Dim i, j, k
DM = Sheet6.Range("B1", Sheet6.Range("F1000000").End(xlUp))
With Sheet2
    k = .Range("B1000000").End(xlUp).Row
    MaHang = .Range("B2:B" & k)
    Kieu = .Range("D2:D" & k)
End With
k = UBound(MaHang)
ReDim Tenhang(1 To k, 1 To 1)
ReDim Machung(1 To k, 1 To 1)
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(DM)
        For j = 1 To 3
            .Item(DM(i, j)) = Array(DM(i, 4), DM(i, 5))
        Next j
    Next i
    For i = 1 To k
        If Kieu(i, 1) <> "" Then
            Chuoi = MaHang(i, 1) & Kieu(i, 1)
            If .exists(Chuoi) Then
                Tenhang(i, 1) = .Item(Chuoi)(0)
                Machung(i, 1) = .Item(Chuoi)(1)
            Else
                Tenhang(i, 1) = "Ko"
                Machung(i, 1) = "Ko"
            End If
        Else
            Chuoi = MaHang(i, 1)
            If .exists(Chuoi) Then
                Tenhang(i, 1) = .Item(Chuoi)(0)
                Machung(i, 1) = .Item(Chuoi)(1)
            Else
                Tenhang(i, 1) = "Ko"
                Machung(i, 1) = "Ko"
            End If
        End If
    Next i
End With
With Sheet2
    .Range("A2").Resize(k, 1).ClearContents
    .Range("A2").Resize(k, 1) = Tenhang
    .Range("H2").Resize(k, 1).ClearContents
    .Range("H2").Resize(k, 1) = Machung
End With
End Sub
 
Upvote 0
Viết cho bạn một Function mà chỉ xài được cho trường hợp trong file của bạn
Con chào Thầy
Cảm ơn Thầy đã giúp đỡ cho con ạ, cái hàm ngắn mà tiện ích quá ạ.

Bạn thử code này xem sao
Mã:
Option Explicit
Sub TimKiem()
Dim DM
Dim MaHang, Kieu, Chuoi
Dim Tenhang, Machung
Dim i, j, k
DM = Sheet6.Range("B1", Sheet6.Range("F1000000").End(xlUp))
With Sheet2
    k = .Range("B1000000").End(xlUp).Row
    MaHang = .Range("B2:B" & k)
    Kieu = .Range("D2:D" & k)
End With
k = UBound(MaHang)
ReDim Tenhang(1 To k, 1 To 1)
ReDim Machung(1 To k, 1 To 1)
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(DM)
        For j = 1 To 3
            .Item(DM(i, j)) = Array(DM(i, 4), DM(i, 5))
        Next j
    Next i
    For i = 1 To k
        If Kieu(i, 1) <> "" Then
            Chuoi = MaHang(i, 1) & Kieu(i, 1)
            If .exists(Chuoi) Then
                Tenhang(i, 1) = .Item(Chuoi)(0)
                Machung(i, 1) = .Item(Chuoi)(1)
            Else
                Tenhang(i, 1) = "Ko"
                Machung(i, 1) = "Ko"
            End If
        Else
            Chuoi = MaHang(i, 1)
            If .exists(Chuoi) Then
                Tenhang(i, 1) = .Item(Chuoi)(0)
                Machung(i, 1) = .Item(Chuoi)(1)
            Else
                Tenhang(i, 1) = "Ko"
                Machung(i, 1) = "Ko"
            End If
        End If
    Next i
End With
With Sheet2
    .Range("A2").Resize(k, 1).ClearContents
    .Range("A2").Resize(k, 1) = Tenhang
    .Range("H2").Resize(k, 1).ClearContents
    .Range("H2").Resize(k, 1) = Machung
End With
End Sub

Xin chào CHAOQUAY,
Cảm ơn bạn nhiều code chạy nhanh và đúng ý OT rồi ạ.
 
Upvote 0
Code của bác CHAOQUAY:
Lặp lại .exists(Chuoi) hai lần, OT rút ngắn lại, nhìn hơi rối. Bỏ nó ra ngoài Điều kiện trước đó thôi
 
Upvote 0
Web KT

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

Back
Top Bottom