Tìm kiếm kết quả theo điều kiện (1 người xem)

[lhthai]

Hiện đang dùng code tìm kiếm sau
Nay muốn bổ sung thêm điều kiện nếu cột Type & Lotno giống nhau mới ra kết quả
Các anh xem file đính kèm.

Private Sub CommandButton1_Click()
Dim Arr(), I As Long, Rng As Range
Arr = Range("I3", [I65536].End(xlUp)).Resize(, 5).Value
For I = 1 To UBound(Arr, 1)
Set Rng = Range("B:B").Find(Arr(I, 1), , , xlWhole)
If Not Rng Is Nothing Then
        Arr(I, 5) = Rng.Offset(, 4)
        End If
           Next
           Range("I3").Resize(I - 1, 5) = Arr
End Sub

 

[Let'GâuGâu]

Hiện đang dùng code tìm kiếm sau
Nay muốn bổ sung thêm điều kiện nếu cột Type & Lotno giống nhau mới ra kết quả
Các anh xem file đính kèm.

Private Sub CommandButton1_Click()
Dim Arr(), I As Long, Rng As Range
Arr = Range("I3", [I65536].End(xlUp)).Resize(, 5).Value
For I = 1 To UBound(Arr, 1)
Set Rng = Range("B:B").Find(Arr(I, 1), , , xlWhole)
If Not Rng Is Nothing Then
        Arr(I, 5) = Rng.Offset(, 4)
        End If
           Next
           Range("I3").Resize(I - 1, 5) = Arr
End Sub

thử............

Private Sub CommandButton1_Click()
Dim Arr1, Arr2 As Variant, I, j As Long
[M2:M10000].ClearContents
Arr1 = Range("b3", [b65536].End(xlUp)).Resize(, 5).Value
Arr2 = Range("I3", [I65536].End(xlUp)).Resize(, 5).Value

For I = 1 To UBound(Arr2)
    For j = 1 To UBound(Arr1)
        If Arr2(I, 1) = Arr1(j, 1) And Arr2(I, 4) = Arr1(j, 4) Then
            Arr2(I, 5) = Arr1(j, 5)
            Exit For
        End If
    Next
Next

Range("I3").Resize(I - 1, 5) = Arr2
End Sub

 

[comet_1701]

Hiện đang dùng code tìm kiếm sau
Nay muốn bổ sung thêm điều kiện nếu cột Type & Lotno giống nhau mới ra kết quả
Các anh xem file đính kèm.

Private Sub CommandButton1_Click()
Dim Arr(), I As Long, Rng As Range
Arr = Range("I3", [I65536].End(xlUp)).Resize(, 5).Value
For I = 1 To UBound(Arr, 1)
Set Rng = Range("B:B").Find(Arr(I, 1), , , xlWhole)
If Not Rng Is Nothing Then
        Arr(I, 5) = Rng.Offset(, 4)
        End If
           Next
           Range("I3").Resize(I - 1, 5) = Arr
End Sub

Hoặc

Sub Loc()
Dim Arr(), I As Long, Rng As Range, Sarr, Tmp As String, Tm1 As String
Arr = Range("I3", [I65536].End(xlUp)).Resize(, 5).Value2
Sarr = Range("B3", [B65536].End(xlUp)).Resize(, 5).Value2
For I = 1 To UBound(Arr, 1)
    For j = 1 To UBound(Sarr, 1)
        Tmp = Arr(I, 1) & "#" & Arr(I, 4)
        tmp1 = Sarr(j, 1) & "#" & Sarr(j, 4)


    Set Rng = Range("B:B").Find(Arr(I, 1), , , xlWhole)
        If Not Rng Is Nothing And Tmp = tmp1 Then
            Arr(I, 5) = Rng.Offset(, 4)
        End If
    Next j
Next I
    Range("I3").Resize(I - 1, 5).ClearContents
    Range("I3").Resize(I - 1, 5) = Arr
    Set Rng = Nothing
End Sub

 

[lhthai]

Hoặc

Sub Loc()
Dim Arr(), I As Long, Rng As Range, Sarr, Tmp As String, Tm1 As String
Arr = Range("I3", [I65536].End(xlUp)).Resize(, 5).Value2
Sarr = Range("B3", [B65536].End(xlUp)).Resize(, 5).Value2
For I = 1 To UBound(Arr, 1)
    For j = 1 To UBound(Sarr, 1)
        Tmp = Arr(I, 1) & "#" & Arr(I, 4)
        tmp1 = Sarr(j, 1) & "#" & Sarr(j, 4)


    Set Rng = Range("B:B").Find(Arr(I, 1), , , xlWhole)
        If Not Rng Is Nothing And Tmp = tmp1 Then
            Arr(I, 5) = Rng.Offset(, 4)
        End If
    Next j
Next I
    Range("I3").Resize(I - 1, 5).ClearContents
    Range("I3").Resize(I - 1, 5) = Arr
    Set Rng = Nothing
End Sub

Cám ơn bạn nhiều
Bài này dùng Dic được không?
Bạn có thể viết để học hỏi thêm

 

[comet_1701]

Cám ơn bạn nhiều
Bài này dùng Dic được không?
Bạn có thể viết để học hỏi thêm

Sub Dictionary()
Dim Arr1, Arr2 As Variant, I, j As Long, Dic As Object, t, _
Tmp As String, Tmp1 As String
t = Timer
Arr1 = Range("b3", [b65536].End(xlUp)).Resize(, 5).Value
Arr2 = Range("I3", [I65536].End(xlUp)).Resize(, 5).Value
Set Dic = CreateObject("Scripting.Dictionary")


For I = 1 To UBound(Arr2)
    For j = 1 To UBound(Arr1)
        Tmp = Arr2(I, 1) & "#" & Arr2(I, 4)
        Tmp1 = Arr1(j, 1) & "#" & Arr1(j, 4)
            If Not Dic.exists(Tmp) Then
                Dic.Add Tmp, ""
            End If
            If Not Dic.exists(Tmp1) Then
                Dic.Add Tmp1, ""
            End If
            If Tmp = Tmp1 Then
                Arr2(I, 5) = Arr1(j, 5)
            End If
    Next
Next
Range("I3").Resize(I - 1, 5).ClearContents
Range("I3").Resize(I - 1, 5) = Arr2
Debug.Print Timer - t
Set Dic = Nothing
End Sub

 

[lhthai]

Sub Dictionary()
Dim Arr1, Arr2 As Variant, I, j As Long, Dic As Object, t, _
Tmp As String, Tmp1 As String
t = Timer
Arr1 = Range("b3", [b65536].End(xlUp)).Resize(, 5).Value
Arr2 = Range("I3", [I65536].End(xlUp)).Resize(, 5).Value
Set Dic = CreateObject("Scripting.Dictionary")


For I = 1 To UBound(Arr2)
    For j = 1 To UBound(Arr1)
        Tmp = Arr2(I, 1) & "#" & Arr2(I, 4)
        Tmp1 = Arr1(j, 1) & "#" & Arr1(j, 4)
            If Not Dic.exists(Tmp) Then
                Dic.Add Tmp, ""
            End If
            If Not Dic.exists(Tmp1) Then
                Dic.Add Tmp1, ""
            End If
            If Tmp = Tmp1 Then
                Arr2(I, 5) = Arr1(j, 5)
            End If
    Next
Next
Range("I3").Resize(I - 1, 5).ClearContents
Range("I3").Resize(I - 1, 5) = Arr2
Debug.Print Timer - t
Set Dic = Nothing
End Sub

Cám ơn bạn nhiều!!!!!!!!!!!

 

[lhthai]

Sub Dictionary()
Dim Arr1, Arr2 As Variant, I, j As Long, Dic As Object, t, _
Tmp As String, Tmp1 As String
t = Timer
Arr1 = Range("b3", [b65536].End(xlUp)).Resize(, 5).Value
Arr2 = Range("I3", [I65536].End(xlUp)).Resize(, 5).Value
Set Dic = CreateObject("Scripting.Dictionary")


For I = 1 To UBound(Arr2)
    For j = 1 To UBound(Arr1)
        Tmp = Arr2(I, 1) & "#" & Arr2(I, 4)
        Tmp1 = Arr1(j, 1) & "#" & Arr1(j, 4)
            If Not Dic.exists(Tmp) Then
                Dic.Add Tmp, ""
            End If
            If Not Dic.exists(Tmp1) Then
                Dic.Add Tmp1, ""
            End If
            If Tmp = Tmp1 Then
                Arr2(I, 5) = Arr1(j, 5)
            End If
    Next
Next
Range("I3").Resize(I - 1, 5).ClearContents
Range("I3").Resize(I - 1, 5) = Arr2
Debug.Print Timer - t
Set Dic = Nothing
End Sub

Chào bạn
Cho mình hỏi thêm về dấu "#" có ý nghĩa là gì nếu bỏ dấu "#" kết quả vẫn chạy được