Dò tìm trong nhiều cột, lấy kết quả trong 1 cột?

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
969
Được thích
765
Điểm
560
Đ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.
 

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,187
Được thích
15,880
Điểm
1,860
Tuổi
60
Nơi ở
An Giang

File đính kèm

CHAOQUAY

Thành viên tiêu biểu
Tham gia ngày
24 Tháng tám 2018
Bài viết
730
Được thích
651
Điểm
360
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
 

Nguyễn Hoàng Oanh Thơ

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,023
Được thích
393
Điểm
235
Nơi ở
Hà Nội
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 ạ.
 

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
969
Được thích
765
Điểm
560
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
 
Top Bottom