Code dò tìm thỏa mãn nhiều điều kiện

Anhduong2015 · 5/8/21

Kính gửi: anh/chị
Em đang thực hiện bài toán dò tìm thỏa mãn nhiều điều kiện
- Hiện tại em đang sử dụng công thức Lookup tuy nhiên em muốn dùng code để tối ưu tốc độ nhưng em viết nó chỉ lấy được dòng đầu tiên tìm thấy theo cách của dò tìm 01 điều kiện
- Do kiến thức còn non nớt suy nghĩ rất nhiều mà không ra lối mong các anh/chị có kinh nghiệm hướng dẫn trợ giúp thêm
Thành thật cám ơn

HUONGHCKT · 5/8/21

Anhduong2015 đã viết:
Kính gửi: anh/chị
Em đang thực hiện bài toán dò tìm thỏa mãn nhiều điều kiện
- Hiện tại em đang sử dụng công thức Lookup tuy nhiên em muốn dùng code để tối ưu tốc độ nhưng em viết nó chỉ lấy được dòng đầu tiên tìm thấy theo cách của dò tìm 01 điều kiện
- Do kiến thức còn non nớt suy nghĩ rất nhiều mà không ra lối mong các anh/chị có kinh nghiệm hướng dẫn trợ giúp thêm
Thành thật cám ơn
View attachment 263601
View attachment 263602
View attachment 263603

Của bạn đây. nhấn nút "Run code ABC" và kiểm tra kết quả tại ô T11:T(n)

Anhduong2015 · 5/8/21

HUONGHCKT đã viết:
Của bạn đây. nhấn nút "Run code ABC" và kiểm tra kết quả tại ô T11:T(n)

Xin cám ơn bạn rất nhiều nhé, code ra kết quả đúng như mong đợi.
Nhân tiện bạn cho mình hỏi thêm là 02 biến "Dd,Db" mình khai báo không có chữ as ngoài sau thì nó là kiểu gì vậy bạn theo như trong bài mình hiểu là kiểu String không biết có đúng hay không? với lại D là viết tắt của từ gì để sau này mình áp dụng theo quy tắc cho dễ nhớ.

HUONGHCKT · 5/8/21

Anhduong2015 đã viết:
Xin cám ơn bạn rất nhiều nhé, code ra kết quả đúng như mong đợi.
Nhân tiện bạn cho mình hỏi thêm là 02 biến "Dd,Db" mình khai báo không có chữ as ngoài sau thì nó là kiểu gì vậy bạn theo như trong bài mình hiểu là kiểu String không biết có đúng hay không? với lại D là viết tắt của từ gì để sau này mình áp dụng theo quy tắc cho dễ nhớ.

Mình học mót và chắp vá kiến thức VBA nên cũng gà mờ thôi. theo mình hiểu thì nếu không khai báo biến thì cũng vẫn chạy được nhung có khai báo biến cho tường minh, khai báo không có chữ as trình dịch sẽ hiểu là varian (có thể là số (long) hay (byte) hay là interger hoặc có thể là string). Không biết là mình hiểu thế có đúng không.
Khai báo biến mình thường Việt hóa cho dễ đọc (cho bản thân mình thôi): Db là điều kiện BB, Dd là điều kiện Data. Các anh chị chuyên nghiệp thường đặt tên biến hay tên hàm theo tiếng Anh. bạn đọc code của họ sẽ thấy.
Chúc vui, khỏe, thành công nhé.

Ba Tê · 9/8/21

HUONGHCKT đã viết:
Mình học mót và chắp vá kiến thức VBA nên cũng gà mờ thôi. theo mình hiểu thì nếu không khai báo biến thì cũng vẫn chạy được nhung có khai báo biến cho tường minh, khai báo không có chữ as trình dịch sẽ hiểu là varian (có thể là số (long) hay (byte) hay là interger hoặc có thể là string). Không biết là mình hiểu thế có đúng không.
Khai báo biến mình thường Việt hóa cho dễ đọc (cho bản thân mình thôi): Db là điều kiện BB, Dd là điều kiện Data. Các anh chị chuyên nghiệp thường đặt tên biến hay tên hàm theo tiếng Anh. bạn đọc code của họ sẽ thấy.
Chúc vui, khỏe, thành công nhé.

Dùng 2 for lồng nhau như bài #2 thì phải duyệt 3052*48 lần.
Nếu dùng Dic chỉ cần 3052+48 lần, code gọn hơn, với dữ liệu lớn có thể nhanh hơn chút nào đó. Thử xem sao.

PHP:

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, R As Long, Txt As String
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
    sArr = Sheets("DATA").Range("R5", Sheets("DATA").Range("T100000").End(xlUp)).Value2
    R = UBound(sArr)
    For I = 1 To R
        Dic.Item(sArr(I, 1) & "#" & sArr(I, 2)) = sArr(I, 3)
    Next I
    '========================================================='
With Sheets("BB_KIEMTRA")
    sArr = .Range("I11", .Range("L100000").End(xlUp)).Value2
    R = UBound(sArr)
        ReDim dArr(1 To R, 1 To 1)
    For I = 1 To R
        Txt = sArr(I, 1) & "#" & sArr(I, 4)
        If Dic.Exists(Txt) Then dArr(I, 1) = Dic.Item(Txt)
    Next I
    .Range("M11").Resize(R) = dArr
End With
Set Dic = Nothing
End Sub

Trong code bài #2, nếu tìm được giá trị cần tìm thì "nghỉ, em chả... chạy nữa đâu!" sẽ "hà tiện" sức:

PHP:

                For j = 1 To UBound(ArrD, 1)
                    Dd = ArrD(j, 1) & ArrD(j, 2)
                    If Db = Dd Then
                        KQ(I, 1) = ArrD(j, 3)
                        Exit For         'nghỉ, em chả... chạy nữa đâu! mệt goooòi'
                    End If
                Next j

Cá ngừ F1 · 9/8/21

Thử code kiểu lượm lặt này xem được không bạn

Mã:

Sub TimKiem()
Dim i&, k&, Dic As Object, Data(), KQ(), BBKT(), Itm1, Itm2
'On Error Resume Next
Data = Range(Sheets("Data").[R4], Sheets("data").[U1000000].End(3))
BBKT = Range(Sheets("BB_KIEMTRA").[I11], Sheets("BB_KIEMTRA").[L1000000].End(3))
ReDim KQ(1 To UBound(BBKT), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Data)
    Itm1 = CStr(Data(i, 1) & Data(i, 2))
    If Not Dic.Exists(Itm1) Then
        Dic.Add Itm1, i
    End If
Next
For i = 1 To UBound(BBKT)
    Itm2 = CStr(BBKT(i, 1) & BBKT(i, 4))
    KQ(i, 1) = Data(Dic.Item(Itm2), 3)
Next
Sheets("BB_KIEMTRA").[M11].Resize(i - 1, 1) = KQ
End Sub

Bài đã được tự động gộp: 9/8/21

Ba Tê đã viết:

Dùng 2 for lồng nhau như bài #2 thì phải duyệt 3052*48 lần.
Nếu dùng Dic chỉ cần 3052+48 lần, code gọn hơn, với dữ liệu lớn có thể nhanh hơn chút nào đó. Thử xem sao.

PHP:

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, R As Long, Txt As String
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
    sArr = Sheets("DATA").Range("R5", Sheets("DATA").Range("T100000").End(xlUp)).Value2
    R = UBound(sArr)
    For I = 1 To R
        Dic.Item(sArr(I, 1) & "#" & sArr(I, 2)) = sArr(I, 3)
    Next I
    '========================================================='
With Sheets("BB_KIEMTRA")
    sArr = .Range("I11", .Range("L100000").End(xlUp)).Value2
    R = UBound(sArr)
        ReDim dArr(1 To R, 1 To 1)
    For I = 1 To R
        Txt = sArr(I, 1) & "#" & sArr(I, 4)
        If Dic.Exists(Txt) Then dArr(I, 1) = Dic.Item(Txt)
    Next I
    .Range("M11").Resize(R) = dArr
End With
Set Dic = Nothing
End Sub

Trong code bài #2, nếu tìm được giá trị cần tìm thì "nghỉ, em chả... chạy nữa đâu!" sẽ "hà tiện" sức:

PHP:

                For j = 1 To UBound(ArrD, 1)
                    Dd = ArrD(j, 1) & ArrD(j, 2)
                    If Db = Dd Then
                        KQ(I, 1) = ArrD(j, 3)
                        Exit For         'nghỉ, em chả... chạy nữa đâu! mệt goooòi'
                    End If
                Next j

Em chào bác 3T
Cho em hỏi thêm chút là trong code của bác có thêm dòng code "Dic.CompareMode = vbTextCompare"
trong Key e thấy thêm cả dấu "#"
Liệu có phải là bẫy lỗi với tiếng Việt có dấu không ạ?

HUONGHCKT · 9/8/21

Ba Tê đã viết:

Dùng 2 for lồng nhau như bài #2 thì phải duyệt 3052*48 lần.
Nếu dùng Dic chỉ cần 3052+48 lần, code gọn hơn, với dữ liệu lớn có thể nhanh hơn chút nào đó. Thử xem sao.

PHP:

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, R As Long, Txt As String
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
    sArr = Sheets("DATA").Range("R5", Sheets("DATA").Range("T100000").End(xlUp)).Value2
    R = UBound(sArr)
    For I = 1 To R
        Dic.Item(sArr(I, 1) & "#" & sArr(I, 2)) = sArr(I, 3)
    Next I
    '========================================================='
With Sheets("BB_KIEMTRA")
    sArr = .Range("I11", .Range("L100000").End(xlUp)).Value2
    R = UBound(sArr)
        ReDim dArr(1 To R, 1 To 1)
    For I = 1 To R
        Txt = sArr(I, 1) & "#" & sArr(I, 4)
        If Dic.Exists(Txt) Then dArr(I, 1) = Dic.Item(Txt)
    Next I
    .Range("M11").Resize(R) = dArr
End With
Set Dic = Nothing
End Sub

Trong code bài #2, nếu tìm được giá trị cần tìm thì "nghỉ, em chả... chạy nữa đâu!" sẽ "hà tiện" sức:

PHP:

                For j = 1 To UBound(ArrD, 1)
                    Dd = ArrD(j, 1) & ArrD(j, 2)
                    If Db = Dd Then
                        KQ(I, 1) = ArrD(j, 3)
                        Exit For         'nghỉ, em chả... chạy nữa đâu! mệt goooòi'
                    End If
                Next j

Cảm ơn anh đã chỉ giáo. Dùng dic chắc chắn sẽ nhanh hơn nhiều, nhất là những bài có dữ liệu nhiều dòng, nhiều cột.
Còn cái vụ exit For tôi cũng đã làm và bên dưới nó còn một đoạn msgbox "...." nữa và khi thử chay code nhiều lần thấy ổn rối xóa bỏ msgbox đã xóa cả exit for. một lần nữa trân trọng cảm ơn anh.

Ba Tê · 9/8/21

Cá ngừ F1 đã viết:
Thử code kiểu lượm lặt này xem được không bạn

Mã:

Sub TimKiem() Dim i&, k&, Dic As Object, Data(), KQ(), BBKT(), Itm1, Itm2 'On Error Resume Next Data = Range(Sheets("Data").[R4], Sheets("data").[U1000000].End(3)) BBKT = Range(Sheets("BB_KIEMTRA").[I11], Sheets("BB_KIEMTRA").[L1000000].End(3)) ReDim KQ(1 To UBound(BBKT), 1 To 1) Set Dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(Data) Itm1 = CStr(Data(i, 1) & Data(i, 2)) If Not Dic.Exists(Itm1) Then Dic.Add Itm1, i End If Next For i = 1 To UBound(BBKT) Itm2 = CStr(BBKT(i, 1) & BBKT(i, 4)) KQ(i, 1) = Data(Dic.Item(Itm2), 3) Next Sheets("BB_KIEMTRA").[M11].Resize(i - 1, 1) = KQ End Sub

Bài đã được tự động gộp: 9/8/21

Em chào bác 3T
Cho em hỏi thêm chút là trong code của bác có thêm dòng code "Dic.CompareMode = vbTextCompare"
trong Key e thấy thêm cả dấu "#"
Liệu có phải là bẫy lỗi với tiếng việt có dấu không ạ?

Lâu rồi mới thấy "Cá ngừ" xuất hiện.
Cũng là học lóm trên GPE và học luôn cách "phòng bệnh".
Dic.CompareMode = vbTextCompare - Không phân biệt chữ HOA - thường.
Thêm dấu "#" đề phòng trường hợp 2 chuỗi khác nhau ghép lại thành giống nhau, ví dụ:
abc - defg
abcd - efg

@Cá ngừ F1 "tiếng việt" nên viêt là "tiếng Việt".

Cá ngừ F1 · 9/8/21

Ba Tê đã viết:
Lâu rồi mới thấy "cá ngừ" xuất hiện.
Cũng là học lóm trên GPE và học luôn cách "phòng bệnh".
Dic.CompareMode = vbTextCompare - Không phân biệt chữ HOA - thường.
Thêm dấu "#" đề phòng trường hợp 2 chuỗi khác nhau ghép lại thành giống nhau, ví dụ:
abc - defg
abcd - efg

wow, chuẩn chuẩn ạ, Key quá quan trọng.
Dạo này dịch dã quá, Cá Ngừ lặn sâu dưới đáy đại dương ạ, hehe.
Sửa ngay cho chắc:

Mã:

Sub TimKiem()
Dim i&, k&, Dic As Object, Data(), KQ(), BBKT(), Itm1, Itm2
'On Error Resume Next
Data = Range(Sheets("Data").[R4], Sheets("data").[U1000000].End(3))
BBKT = Range(Sheets("BB_KIEMTRA").[I11], Sheets("BB_KIEMTRA").[L1000000].End(3))
ReDim KQ(1 To UBound(BBKT), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
For i = 1 To UBound(Data)
    Itm1 = Data(i, 1) & "#" & Data(i, 2)
    If Not Dic.Exists(Itm1) Then
        Dic.Add Itm1, Data(i, 3)
    End If
Next
For i = 1 To UBound(BBKT)
    Itm2 = BBKT(i, 1) & "#" & BBKT(i, 4)
    KQ(i, 1) = Dic.Item(Itm2)
Next
Sheets("BB_KIEMTRA").[M11].Resize(i - 1, 1) = KQ
End Sub

HUONGHCKT · 9/8/21

Ba Tê đã viết:
Lâu rồi mới thấy "Cá ngừ" xuất hiện.
Cũng là học lóm trên GPE và học luôn cách "phòng bệnh".
Dic.CompareMode = vbTextCompare - Không phân biệt chữ HOA - thường.
Thêm dấu "#" đề phòng trường hợp 2 chuỗi khác nhau ghép lại thành giống nhau, ví dụ:
abc - defg
abcd - efg

@Cá ngừ F1 "tiếng việt" nên viêt là "tiếng Việt".

Nhiều bạn đọc (trong đó có tôi) lại được bổ sung một kiến thức tuy đơn giản nhưng hết sức quan trọng nữa rồi. Cảm ơn anh Ba Tê.

truongvu317 · 9/8/21

Cá ngừ F1 đã viết:
CStr

Điều gì khiến sub có sử dụng tới hàm cstr á bạn?

Cá ngừ F1 · 9/8/21

truongvu317 đã viết:
Điều gì khiến sub có sử dụng tới hàm cstr á bạn?

Ah, tình huống này thì bỏ đi cũng không vấn đề gì, vì toàn là text.
Nhiều khi thành thói quen, với kiểu dữ liệu số không nhận ra nhau thôi bạn.

Anhduong2015 · 9/8/21

Xin cám ơn tất cả anh/ chị đã giúp đỡ và mở rộng thêm nhiều kiến thức mới lạ, hấp dẫn và kỳ diệu

Chúc các anh/chị giữ gìn và có nhiều sức khỏe, bình an trong đợt dịch bệnh thế kỷ này.

Code dò tìm thỏa mãn nhiều điều kiện

Anhduong2015

Thành viên chính thức

File đính kèm

HUONGHCKT

Zalo 0986997214

File đính kèm

Anhduong2015

Thành viên chính thức

HUONGHCKT

Zalo 0986997214

Ba Tê

Cạo Rồi Khỏi Gội

Cá ngừ F1

( ͡° ͜ʖ ͡°)

File đính kèm

HUONGHCKT

Zalo 0986997214

Ba Tê

Cạo Rồi Khỏi Gội

Cá ngừ F1

( ͡° ͜ʖ ͡°)

HUONGHCKT

Zalo 0986997214

truongvu317

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

Cá ngừ F1

( ͡° ͜ʖ ͡°)

Anhduong2015

Thành viên chính thức

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