Tìm kiếm và liệt kê doanh sách Vlookup (1 người xem)

Liên hệ QC

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

thaibao1306

Thành viên mới
Tham gia
14/1/19
Bài viết
1
Được thích
0
Chào mọi người,
Em có một danh sách khách hàng trả trước.
Mỗi ngày em sẽ nhập dữ liệu đơn hàng.
YÊU CẦU:tự động lọc ra những khác hàng trả trước ghi vào sheet "các đơn hàng đc trả trước".
p/s em đã dùng vlookup và các index-match, nhưng bị một vấn đề là những ô không tìm đc cũng xuất hiện, em muốn list ra chỉ những giá khách trả trước thôi (bằng cách dùng hàm hoặc code VBA, không dùng filter)
Em xin cám ơn.
 

File đính kèm

Chào mọi người,
Em có một danh sách khách hàng trả trước.
Mỗi ngày em sẽ nhập dữ liệu đơn hàng.
YÊU CẦU:tự động lọc ra những khác hàng trả trước ghi vào sheet "các đơn hàng đc trả trước".
p/s em đã dùng vlookup và các index-match, nhưng bị một vấn đề là những ô không tìm đc cũng xuất hiện, em muốn list ra chỉ những giá khách trả trước thôi (bằng cách dùng hàm hoặc code VBA, không dùng filter)
Em xin cám ơn.
Bạn xem code.Nhưng cách làm của bạn thấy cũng không hợp lý lắm.
Mã:
Sub danhsach()
Dim arr, arr1
Dim dic As Object
Dim a As Long, i As Long, j As Long, lr As Long
Set dic = CreateObject("scripting.dictionary")
With Sheet1
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     arr = .Range("A2:B" & lr).Value
     For i = 1 To UBound(arr, 1)
        If Not dic.exists(arr(i, 1)) Then
        dic.Add arr(i, 1), arr(i, 2)
        End If
     Next i
End With
With Sheet2
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     If lr < 2 Then Exit Sub
     arr = .Range("A2:B" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 3)
     For i = 1 To UBound(arr, 1)
         If dic.exists(arr(i, 2)) Then
            a = a + 1
            arr1(a, 1) = arr(i, 1)
            arr1(a, 2) = arr(i, 2)
            arr1(a, 3) = dic.Item(arr(i, 2))
         End If
     Next i
End With
With Sheet3
    lr = .Range("A" & Rows.Count).End(xlUp).Row
     If lr > 1 Then .Range("a2:C" & lr).ClearContents
     If a Then .Range("A2").Resize(a, 3).Value = arr1
End With
End Sub
 

File đính kèm

Web KT

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

Back
Top Bottom