Xin hô trợ code VBA vlookup theo nhiều điều kiện

  • Thread starter Thread starter Pannilly
  • Ngày gửi Ngày gửi
Liên hệ QC

Pannilly

Thành viên mới
Tham gia
17/3/12
Bài viết
20
Được thích
1
Dear mọi người,

Em muốn xin code VBA để vlookup theo 3 điều kiện. Raw data e để ở sheet 1. Bảng lọc e để ở sheet 2

1. Trong khoảng thời gian tùy chọn. (Điều kiện lọc cố định)

2. Type: Fixed Income/ equity ..

3. Fund Management (tùy chọn, nếu bỏ trống thì sẽ lọc theo hai điều kiện 1, 2 trên)

4. Fund. (tùy chọn, nếu bỏ trống thì sẽ lọc theo hai điều kiện 1, 2, 3 trên)



Em cám ơn mn nhiều ạ
 

File đính kèm

Lần chỉnh sửa cuối:
Dear mọi người,

Em muốn xin code VBA để vlookup theo 3 điều kiện. Raw data e để ở sheet 1. Bảng lọc e để ở sheet 2

1. Trong khoảng thời gian tùy chọn. (Điều kiện lọc cố định)

2. Type: Fixed Income/ equity ..

3. Fund Management (tùy chọn, nếu bỏ trống thì sẽ lọc theo hai điều kiện 1, 2 trên)

4. Fund. (tùy chọn, nếu bỏ trống thì sẽ lọc theo hai điều kiện 1, 2, 3 trên)



Em cám ơn mn nhiều ạ
Mã:
Sub A_Loc()
Dim SArr, rws, cls
Dim St, Fn, Type_, FundM, Fund
Dim Res
Dim i, j, k
SArr = Sheet1.Range("A2").CurrentRegion
rws = UBound(SArr)
cls = UBound(SArr, 2)
With Sheet2
    St = .Range("D2")
    Fn = .Range("D4")
    Type_ = .Range("G2")
    FundM = .Range("J2")
    Fund = .Range("J4")
    If .Range("J2") = "" Then FundM = "*"
    If .Range("J4") = "" Then Fund = "*"
End With
With CreateObject("Scripting.Dictionary")
    For i = 3 To rws
        If SArr(i, 1) >= St And SArr(i, 1) <= Fn Then
            If SArr(i, 2) = Type_ Then
                If " " & SArr(i, 3) & " " Like " " & FundM & " " Then
                    If " " & SArr(i, 4) & " " Like " " & Fund & " " Then
                        k = k + 1
                        .Item(i) = ""
                    End If
                End If
            End If
        End If
    Next i
    ReDim Res(1 To .Count + 2, 1 To cls)
    For i = 1 To 2
        For j = 1 To 14
            Res(i, j) = Sheet1.Cells(i + 1, j)
        Next j
    Next i
    k = 2
    For Each i In .keys
        k = k + 1
        For j = 1 To cls
            Res(k, j) = SArr(i, j)
        Next j
    Next i
End With
With Sheet5
    .UsedRange.Clear
    .Range("A1").Resize(UBound(Res), UBound(Res, 2)) = Res
    .UsedRange.Columns.AutoFit
    '.Range("A1") = k
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

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

Back
Top Bottom