Hỏi về VBA rút trích dữ liệu không trùng lặp giữa 2 sheet?

Liên hệ QC
T

thanhphuongvip

Mới học VBA, hỏi ngu anh chị đừng chửi ạ
Tham gia
16/1/10
Bài viết
136
Được thích
22
Nhờ anh em giúp đỡ!

Mình có file Excel gồm 2 sheet GUI HANG và THANH TOAN rồi, trong 2 sheet đều có Mã vận đơn, công việc bây giờ là lấy mỗi Mã vận đơn ở sheet GUI HANG dò vào cột Mã vận đơn ở sheet THANH TOAN, nếu Mã vận đơn nào dò có thì thôi (tức là đã thanh toán rồi), còn mã nào dò không có thì trích toàn bộ thông tin ra sheet thứ 3 mang tên Ma Van Don Chua Thanh Toan để theo dõi (Dữ liệu ở sheet thứ 3 sẽ biến đổi khi dữ liệu ở 1 trong 2 sheet kia biến thôi)

Mục đích của công việc trên là giúp đối chiếu giữa Mã vận đơn bên gửi hàng và bên chuyển phát nhanh thanh toán, xem mã nào chưa đc thanh toán thì đòi tiền lại. Mục đích là vậy.
Xin cảm ơn rất nhiều!


214910
[/URL]
 

File đính kèm

  • DOI CHIEU 2.xlsb
    101.6 KB · Đọc: 14
Sắp xếp theo thời gian sắp xếp theo bầu chọn
thanhphuongvip đã viết:
Nhờ anh em giúp đỡ!

Mình có file Excel gồm 2 sheet GUI HANG và THANH TOAN rồi, trong 2 sheet đều có Mã vận đơn, công việc bây giờ là lấy mỗi Mã vận đơn ở sheet GUI HANG dò vào cột Mã vận đơn ở sheet THANH TOAN, nếu Mã vận đơn nào dò có thì thôi (tức là đã thanh toán rồi), còn mã nào dò không có thì trích toàn bộ thông tin ra sheet thứ 3 mang tên Ma Van Don Chua Thanh Toan để theo dõi (Dữ liệu ở sheet thứ 3 sẽ biến đổi khi dữ liệu ở 1 trong 2 sheet kia biến thôi)

Mục đích của công việc trên là giúp đối chiếu giữa Mã vận đơn bên gửi hàng và bên chuyển phát nhanh thanh toán, xem mã nào chưa đc thanh toán thì đòi tiền lại. Mục đích là vậy.
Xin cảm ơn rất nhiều!


214910
[/URL]
Nhấp chuột vào đây để mở rộng...
Bạn test xem sao
Mã: 
Sub Loc()
Dim Gui
Dim Thanhtoan
Dim Kq
Dim i, j, k
Thanhtoan = Sheet2.Range("a20", Sheet2.Range("a1000000").End(xlUp))
Gui = Sheet1.Range("a3", Sheet1.Range("h1000000").End(xlUp))
ReDim Kq(1 To UBound(Gui), 1 To UBound(Gui, 2))
With CreateObject("Scripting.dictionary")
    For i = 1 To UBound(Thanhtoan)
        .Item(Thanhtoan(i, 1)) = ""
    Next i
    For i = 1 To UBound(Gui)
        If .exists(CStr(Gui(i, 4))) = False Then
            k = k + 1
            Kq(k, 1) = k
            For j = 2 To UBound(Gui, 2)
                Kq(k, j) = Gui(i, j)
            Next j
        End If
    Next i
End With
With Sheet3
    .Range("a4").Resize(UBound(Kq), UBound(Kq, 2)).ClearContents
    .Range("a4").Resize(k, UBound(Kq, 2)) = Kq
End With
End Sub
 
Upvote 0
thanhphuongvip đã viết:
Nhờ anh em giúp đỡ!

Mình có file Excel gồm 2 sheet GUI HANG và THANH TOAN rồi, trong 2 sheet đều có Mã vận đơn, công việc bây giờ là lấy mỗi Mã vận đơn ở sheet GUI HANG dò vào cột Mã vận đơn ở sheet THANH TOAN, nếu Mã vận đơn nào dò có thì thôi (tức là đã thanh toán rồi), còn mã nào dò không có thì trích toàn bộ thông tin ra sheet thứ 3 mang tên Ma Van Don Chua Thanh Toan để theo dõi (Dữ liệu ở sheet thứ 3 sẽ biến đổi khi dữ liệu ở 1 trong 2 sheet kia biến thôi)

Mục đích của công việc trên là giúp đối chiếu giữa Mã vận đơn bên gửi hàng và bên chuyển phát nhanh thanh toán, xem mã nào chưa đc thanh toán thì đòi tiền lại. Mục đích là vậy.
Xin cảm ơn rất nhiều!


214910
[/URL]
Nhấp chuột vào đây để mở rộng...
Bạn xem có đúng không nhé.
Mã: 
Sub layma()
    Dim dic As Object, arr, arr1, i As Long, j As Long, lr As Long, a As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Thanh Toan")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A20:A" & lr).Value
         For i = 1 To UBound(arr, 1)
             If Not dic.exists(arr(i, 1)) Then
                dic.Add arr(i, 1), ""
             End If
         Next i
    End With
    With Sheets("Gui Hang")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         If lr < 3 Then Exit Sub
         arr = .Range("A3:h" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
         For i = 1 To UBound(arr, 1)
             If Not dic.exists(arr(i, 4)) Then
                a = a + 1
                For j = 2 To UBound(arr, 2)
                   arr1(a, j) = arr(i, j)
                Next j
                arr1(a, 1) = a
              End If
         Next i
   End With
   With Sheets("Ma Van Don Chua Thanh Toan")
        lr = .Range("D" & Rows.Count).End(xlUp).Row
        If lr > 3 Then .Range("A4:H" & lr).ClearContents
        If a Then .Range("A4:H4").Resize(a).Value = arr1
   End With
End Sub
 

File đính kèm

  • DOI CHIEU 2.xlsb
    107.6 KB · Đọc: 13
Upvote 0
snow25 đã viết:
Bạn xem có đúng không nhé.
Mã: 
Sub layma()
    Dim dic As Object, arr, arr1, i As Long, j As Long, lr As Long, a As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Thanh Toan")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A20:A" & lr).Value
         For i = 1 To UBound(arr, 1)
             If Not dic.exists(arr(i, 1)) Then
                dic.Add arr(i, 1), ""
             End If
         Next i
    End With
    With Sheets("Gui Hang")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         If lr < 3 Then Exit Sub
         arr = .Range("A3:h" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
         For i = 1 To UBound(arr, 1)
             If Not dic.exists(arr(i, 4)) Then
                a = a + 1
                For j = 2 To UBound(arr, 2)
                   arr1(a, j) = arr(i, j)
                Next j
                arr1(a, 1) = a
              End If
         Next i
   End With
   With Sheets("Ma Van Don Chua Thanh Toan")
        lr = .Range("D" & Rows.Count).End(xlUp).Row
        If lr > 3 Then .Range("A4:H" & lr).ClearContents
        If a Then .Range("A4:H4").Resize(a).Value = arr1
   End With
End Sub
Nhấp chuột vào đây để mở rộng...
Không được bạn ơi, nó ra hết các dòng trong gửi hàng luôn chứ ko có lọc ra những Mã vận đơn ko tìm thấy ở sheet Thanh Toan. Bạn xem lại giúp mình nhé!
Bài đã được tự động gộp:

CHAOQUAY đã viết:
Bạn test xem sao
Mã: 
Sub Loc()
Dim Gui
Dim Thanhtoan
Dim Kq
Dim i, j, k
Thanhtoan = Sheet2.Range("a20", Sheet2.Range("a1000000").End(xlUp))
Gui = Sheet1.Range("a3", Sheet1.Range("h1000000").End(xlUp))
ReDim Kq(1 To UBound(Gui), 1 To UBound(Gui, 2))
With CreateObject("Scripting.dictionary")
    For i = 1 To UBound(Thanhtoan)
        .Item(Thanhtoan(i, 1)) = ""
    Next i
    For i = 1 To UBound(Gui)
        If .exists(CStr(Gui(i, 4))) = False Then
            k = k + 1
            Kq(k, 1) = k
            For j = 2 To UBound(Gui, 2)
                Kq(k, j) = Gui(i, j)
            Next j
        End If
    Next i
End With
With Sheet3
    .Range("a4").Resize(UBound(Kq), UBound(Kq, 2)).ClearContents
    .Range("a4").Resize(k, UBound(Kq, 2)) = Kq
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Mình dán một vài dòng vào test thì có lúc được, có lúc báo lỗi như sau:
214949

Mình có gửi file đính kèm!
 

File đính kèm

  • DOI CHIEU 2 (2).xlsb
    96.5 KB · Đọc: 11
Upvote 0
thanhphuongvip đã viết:
Không được bạn ơi, nó ra hết các dòng trong gửi hàng luôn chứ ko có lọc ra những Mã vận đơn ko tìm thấy ở sheet Thanh Toan. Bạn xem lại giúp mình nhé!
Bài đã được tự động gộp:


Mình dán một vài dòng vào test thì có lúc được, có lúc báo lỗi như sau:
View attachment 214949

Mình có gửi file đính kèm!
Nhấp chuột vào đây để mở rộng...
Bạn chạy lại sub này xem.
Mã: 
Sub layma()
    Dim dic As Object, arr, arr1, i As Long, j As Long, lr As Long, a As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Thanh Toan")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A20:A" & lr).Value
         For i = 1 To UBound(arr, 1)
            dk = arr(i, 1)
             If Not dic.exists(dk) Then
                dic.Add dk, ""
             End If
         Next i
    End With
    With Sheets("Gui Hang")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         If lr < 3 Then Exit Sub
         arr = .Range("A3:h" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
         For i = 1 To UBound(arr, 1)
           dk = arr(i, 4)
             If Not dic.exists(dk) Then
                a = a + 1
                For j = 2 To UBound(arr, 2)
                   arr1(a, j) = arr(i, j)
                Next j
                arr1(a, 1) = a
              End If
         Next i
   End With
   With Sheets("Ma Van Don Chua Thanh Toan")
        lr = .Range("D" & Rows.Count).End(xlUp).Row
        If lr > 3 Then .Range("A4:H" & lr).ClearContents
        If a Then .Range("A4:H4").Resize(a).Value = arr1
   End With
End Sub
 
Upvote 0
thanhphuongvip đã viết:
Không được bạn ơi, nó ra hết các dòng trong gửi hàng luôn chứ ko có lọc ra những Mã vận đơn ko tìm thấy ở sheet Thanh Toan. Bạn xem lại giúp mình nhé!
Bài đã được tự động gộp:


Mình dán một vài dòng vào test thì có lúc được, có lúc báo lỗi như sau:
View attachment 214949

Mình có gửi file đính kèm!
Nhấp chuột vào đây để mở rộng...
Đây là do không bẫy lỗi trường hợp đã thanh toán hết ( k=""). Phần with sheet3 -> đổi k=ubound(kq) sẽ hết lỗi
 
Upvote 0
snow25 đã viết:
Bạn chạy lại sub này xem.
Mã: 
Sub layma()
    Dim dic As Object, arr, arr1, i As Long, j As Long, lr As Long, a As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Thanh Toan")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A20:A" & lr).Value
         For i = 1 To UBound(arr, 1)
            dk = arr(i, 1)
             If Not dic.exists(dk) Then
                dic.Add dk, ""
             End If
         Next i
    End With
    With Sheets("Gui Hang")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         If lr < 3 Then Exit Sub
         arr = .Range("A3:h" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
         For i = 1 To UBound(arr, 1)
           dk = arr(i, 4)
             If Not dic.exists(dk) Then
                a = a + 1
                For j = 2 To UBound(arr, 2)
                   arr1(a, j) = arr(i, j)
                Next j
                arr1(a, 1) = a
              End If
         Next i
   End With
   With Sheets("Ma Van Don Chua Thanh Toan")
        lr = .Range("D" & Rows.Count).End(xlUp).Row
        If lr > 3 Then .Range("A4:H" & lr).ClearContents
        If a Then .Range("A4:H4").Resize(a).Value = arr1
   End With
End Sub
Nhấp chuột vào đây để mở rộng...
Đã sửa và chạy được, hiện tại chưa thấy lỗi gì, cảm ơn Snow nhé!
Bài đã được tự động gộp:

CHAOQUAY đã viết:
Đây là do không bẫy lỗi trường hợp đã thanh toán hết ( k=""). Phần with sheet3 -> đổi k=ubound(kq) sẽ hết lỗi
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn, để mình sửa lại xem sao! <3
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

LuuAnh980
Vấn đề viết tắt trong Diễn Đàn.
    • Thích
    • Cười
2 3
Trả lời
52
Đọc
1K
SA_DQ
SA_DQ
T
xin công thức tính kết chuyển lỗ vào thu nhập tính thuế TNDN trong nhiều năm
Trả lời
0
Đọc
26
trihieu610
T
Bùi Đức Dương
Vba sang Vb.net
Trả lời
4
Đọc
141
VetMini
V
ann266
Kế toán kho F&B
    • Cười
2
Trả lời
27
Đọc
431
ann266
ann266
H
Tính tổng có điều kiện
    • Thích
2
Trả lời
24
Đọc
576
hoaiantrinh
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom