Code VBA tìm mặt hàng chưa xuất bán

[moihocvba]

Em xin chào gia đình GPE!

Xin anh chị giúp em lệnh code này. Em có một bảng NHẬP HÀNG, sau đó là bảng XUẤT BÁN, em cần so sánh 2 bảng NHẬP HÀNG và XUẤT HÀNG để xuất ra danh sách hàng chưa được bán lần nào. (ko cần đối chiếu số lượng, vì nhập bao nhiêu là xuất đi hết bao nhiêu)
Vì dữ liệu của em nhập và xuất tới cả trăm ngàn dòng nên e muốn dòng code vba cho nhanh ạ. Cảm ơn anh chị nhiều!

 

[Nhattanktnn]

Em xin chào gia đình GPE!

Xin anh chị giúp em lệnh code này. Em có một bảng NHẬP HÀNG, sau đó là bảng XUẤT BÁN, em cần so sánh 2 bảng NHẬP HÀNG và XUẤT HÀNG để xuất ra danh sách hàng chưa được bán lần nào. (ko cần đối chiếu số lượng, vì nhập bao nhiêu là xuất đi hết bao nhiêu)
Vì dữ liệu của em nhập và xuất tới cả trăm ngàn dòng nên e muốn dòng code vba cho nhanh ạ. Cảm ơn anh chị nhiều!

View attachment 258952

Bạn vừa mới hỏi một bài tương tự về Dictionary mà vẫn không rút ra được ý tưởng khi làm bài này à? Đầu tiên là add tên hàng đã xuất bán vào Dic, sau đó duyệt tên hàng nhập kho, tên nào chưa có trong dic thì tức là chưa xuất bán. Ghi vào mảng sau đó đổ xuống sheet. Vậy thôi

 

[moihocvba]

Bạn vừa mới hỏi một bài tương tự về Dictionary mà vẫn không rút ra được ý tưởng khi làm bài này à? Đầu tiên là add tên hàng đã xuất bán vào Dic, sau đó duyệt tên hàng nhập kho, tên nào chưa có trong dic thì tức là chưa xuất bán. Ghi vào mảng sau đó đổ xuống sheet. Vậy thôi

Dạ em cũng làm theo cách đó, nhưng bấm cứ ra lỗi, em ko biết sai chỗ nào, a kiểm tra giúp em thử nhé! Em bị tẩu hỏa nhập ma luôn, hihi

Option Explicit
Sub TimMatHang()
Dim Dic As Object, arr(), kq(), arr2(), i As Long, a As Long
Set Dic = CreateObject("Scripting.dictionary")

arr = Range("E3:G5").Value
arr2 = Range("A3:C8").Value
ReDim kq(1 To 1000000, 1 To 3)
For i = 1 To UBound(arr, 1)
    If Not Dic.exists(arr(i, 1)) Then
        Dic.Add arr(i, 1), arr(i, 1)
    End If
Next i

For i = 1 To UBound(arr2, 1)
    If Not Dic.exists(arr(i, 1)) Then
        a = a + 1
        kq(a, 1) = arr2(i, 1)
        kq(a, 2) = arr2(i, 2)
        kq(a, 3) = arr2(i, 3)
    End If
Next i

Range("i3").Resize(a, 3) = kq

End Sub

 

[befaint]

Nhìn ---- thật ---- kỹ ---- chỗ ---- này.

 

[moihocvba]

Nhìn ---- thật ---- kỹ ---- chỗ ---- này.

View attachment 258962

ah em biết rồi, cảm ơn anh đã chỉ điểm. Phải sửa lại thành là "If Not Dic.exists(arr2(i, 1)) Then" mới đúng!
Vậy là em đã tìm ra lỗi rồi, cám ơn anh @befaint và anh Nhattanktnn
Chúc cả nhà một ngày vui vẻ!

 

[Nhattanktnn]

Dạ em cũng làm theo cách đó, nhưng bấm cứ ra lỗi, em ko biết sai chỗ nào, a kiểm tra giúp em thử nhé! Em bị tẩu hỏa nhập ma luôn, hihi

Option Explicit
Sub TimMatHang()
Dim Dic As Object, arr(), kq(), arr2(), i As Long, a As Long
Set Dic = CreateObject("Scripting.dictionary")

arr = Range("E3:G5").Value
arr2 = Range("A3:C8").Value
ReDim kq(1 To 1000000, 1 To 3)
For i = 1 To UBound(arr, 1)
    If Not Dic.exists(arr(i, 1)) Then
        Dic.Add arr(i, 1), arr(i, 1)
    End If
Next i

For i = 1 To UBound(arr2, 1)
    If Not Dic.exists(arr(i, 1)) Then
        a = a + 1
        kq(a, 1) = arr2(i, 1)
        kq(a, 2) = arr2(i, 2)
        kq(a, 3) = arr2(i, 3)
    End If
Next i

Range("i3").Resize(a, 3) = kq

End Sub

Mình sửa cụ thể cho bạn đây:

Option Explicit
Sub TimMatHang()
Dim Dic As Object, arr(), kq(), arr2(), i As Long, a As Long
Set Dic = CreateObject("Scripting.dictionary")
With Sheets("Sheet1") 'Nen xac dinh ro dang lam viec voi sheet nao
    arr = .Range("E3:G5").Value 'Them dau cham truoc range de biet no thuoc sheet1
    arr2 = .Range("A3:C8").Value
    ReDim kq(1 To UBound(arr2, 1), 1 To 3) 'Redim dong chi can bang ubound(arr2,1) vi toi da chi co the vay
    For i = 1 To UBound(arr, 1)
        'If Not Dic.exists(arr(i, 1)) Then : Bo dong nay vi chac chan chua co trong dic
        'Có the them dieu kien khac rong (cho truong hop khac): if arr(i,1)<>"" then
            Dic.Add arr(i, 1), ""
        'End If
    Next i
   
    For i = 1 To UBound(arr2, 1)
        If Not Dic.exists(arr2(i, 1)) Then 'Dang duyt arr2 ma ban de arr la sai
            a = a + 1
            kq(a, 1) = arr2(i, 1)
            kq(a, 2) = arr2(i, 2)
            kq(a, 3) = arr2(i, 3)
        End If
    Next i
    .Range("I3").Resize(10000, 3).ClearContents 'Nen xoa du lieu cu truoc khi dan, tranh truong hop du lieu cu dài hon, không phát hien duoc
    .Range("i3").Resize(a, 3) = kq
End With
set dic=nothing 'Giai phong bien
End Sub

 

[befaint]

.Range("i3").Resize(a, 3) = kq

Quên kiểm tra biến a rồi.

 

[Nhattanktnn]

Quên kiểm tra biến a rồi.

Anh nói chỉ có chuẩn hihi

 

[moihocvba]

Quên kiểm tra biến a rồi.

Nếu như tới chỗ đó hết sub thì thay vì ghi if a > 0 then.... thì em cho lệnh này vào được ko a: "on error resume next"

    .Range("I3").Resize(10000, 3).ClearContents 'Nen xoa du lieu cu truoc khi dan, tranh truong hop du lieu cu dài hon, không phát hien duoc
    on error resume next
    .Range("i3").Resize(a, 3) = kq

 

[Nhattanktnn]

Nếu như tới chỗ đó hết sub thì thay vì ghi if a > 0 then.... thì em cho lệnh này vào được ko a: "on error resume next"

    .Range("I3").Resize(10000, 3).ClearContents 'Nen xoa du lieu cu truoc khi dan, tranh truong hop du lieu cu dài hon, không phát hien duoc
    on error resume next
    .Range("i3").Resize(a, 3) = kq

Được thì được, nhưng cái gì cụ thể được thì làm cụ thể ra, bẫy lỗi kiểu vậy là chung chung, nếu còn nữa thì khó mà lần lỗi