So sánh dữ liệu theo cột 2 sheet khác nhau!!!

Liên hệ QC
trieucuong.ise17

trieucuong.ise17

Thành viên mới
Tham gia
1/3/21
Bài viết
8
Được thích
1
Chào các thầy và các bạn!

Em đang học về VBA thôi nên chưa có nhiều kiến thức và đang gặp bài toán nan giải.
Mục đích là dò tìm theo mã sản xuất ở cột D sheet "MPS" và so sánh với mã sản xuất ở cột D sheet "Theo dõi". Nếu mã sản xuất chưa có ở cột D sheet "Theo dõi" thì copy các hàng chứa mã sản xuất không bị trùng và chèn lên đầu các đơn hàng (hàng thứ 3). Nếu mã sản xuất trùng thì sẽ bỏ qua.
Em có đính kèm file Excel mẫu bên dưới.
Cảm ơn các thầy và các bạn giúp đỡ!
 

File đính kèm

  • Theo dõi Sản xuất.xlsx
    10.9 KB · Đọc: 11
Sắp xếp theo thời gian sắp xếp theo bầu chọn
trieucuong.ise17 đã viết:
Chào các thầy và các bạn!

Em đang học về VBA thôi nên chưa có nhiều kiến thức và đang gặp bài toán nan giải.
Mục đích là dò tìm theo mã sản xuất ở cột D sheet "MPS" và so sánh với mã sản xuất ở cột D sheet "Theo dõi". Nếu mã sản xuất chưa có ở cột D sheet "Theo dõi" thì copy các hàng chứa mã sản xuất không bị trùng và chèn lên đầu các đơn hàng (hàng thứ 3). Nếu mã sản xuất trùng thì sẽ bỏ qua.
Em có đính kèm file Excel mẫu bên dưới.
Cảm ơn các thầy và các bạn giúp đỡ!
Nhấp chuột vào đây để mở rộng...
Ngắn gọn là dò mã (cột D) trong sheet "MPS" đối chiếu sheet "Theo dõi", nếu trong sheet "theo dõi" không có mã đó thì copy toàn bộ dòng đó bên "MPS" chèn lên đầu dòng (dòng 3) sheet "Theo dõi" phải không?
 
Upvote 0
trieucuong.ise17 đã viết:
Vâng anh nói đúng rồi ấy ạ!
Nhấp chuột vào đây để mở rộng...
Sửa tên sheet "Theo dõi" thành "TheoDoi" và chạy thử code này xem sao
Mã: 
Option Explicit

Sub CopyPaste()
Dim ArrMPS(), ArrTD(), I&, J&, K&, Res(), iCol&
ArrTD = Sheets("TheoDoi").Range("A3:O" & Sheets("TheoDoi").Cells(Rows.Count, "D").End(xlUp).Row).Value
With Sheets("MPS")
    ArrMPS = .Range("A3:O" & .Cells(Rows.Count, "D").End(xlUp).Row).Value
    ReDim Res(1 To UBound(ArrMPS), 1 To UBound(ArrMPS, 2))
    For I = 1 To UBound(ArrMPS)
        For J = 1 To UBound(ArrTD)
            If ArrMPS(I, 4) = ArrTD(J, 4) Then
                Exit For
            End If
        Next
        If J > UBound(ArrTD) Then
            K = K + 1
            For iCol = 1 To UBound(ArrMPS, 2)
                Res(K, iCol) = ArrMPS(I, iCol)
            Next
        End If
    Next
End With
If K Then
    Sheets("TheoDoi").Rows("3:" & K + 2).Insert
    Sheets("TheoDoi").Range("A3").Resize(K, UBound(ArrMPS, 2)) = Res
End If
End Sub
 
Upvote 0
Nhattanktnn đã viết:
Sửa tên sheet "Theo dõi" thành "TheoDoi" và chạy thử code này xem sao
Mã: 
Option Explicit

Sub CopyPaste()
Dim ArrMPS(), ArrTD(), I&, J&, K&, Res(), iCol&
ArrTD = Sheets("TheoDoi").Range("A3:O" & Sheets("TheoDoi").Cells(Rows.Count, "D").End(xlUp).Row).Value
With Sheets("MPS")
    ArrMPS = .Range("A3:O" & .Cells(Rows.Count, "D").End(xlUp).Row).Value
    ReDim Res(1 To UBound(ArrMPS), 1 To UBound(ArrMPS, 2))
    For I = 1 To UBound(ArrMPS)
        For J = 1 To UBound(ArrTD)
            If ArrMPS(I, 4) = ArrTD(J, 4) Then
                Exit For
            End If
        Next
        If J > UBound(ArrTD) Then
            K = K + 1
            For iCol = 1 To UBound(ArrMPS, 2)
                Res(K, iCol) = ArrMPS(I, iCol)
            Next
        End If
    Next
End With
If K Then
    Sheets("TheoDoi").Rows("3:" & K + 2).Insert
    Sheets("TheoDoi").Range("A3").Resize(K, UBound(ArrMPS, 2)) = Res
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Dữ liệu nhiều chạy mệt lắm
 
Upvote 0
Em chân thành cảm ơn ạ. Nhưng nếu sheet "TheoDoi" em được yêu cầu sửa lại như file đính kèm thì VBA phải sửa ở đâu ạ?
 

File đính kèm

  • Theo dõi Sản xuất.xlsx
    11.3 KB · Đọc: 6
Upvote 0
trieucuong.ise17 đã viết:
Em chân thành cảm ơn ạ. Nhưng nếu sheet "TheoDoi" em được yêu cầu sửa lại như file đính kèm thì VBA phải sửa ở đâu ạ?
Nhấp chuột vào đây để mở rộng...
Bạn google "insert module trong vba" và tìm hiểu thêm nhé!
HieuCD đã viết:
Dữ liệu nhiều chạy mệt lắm
Nhấp chuột vào đây để mở rộng...
Liên quan tới bài kiểu này, bác Hiếu cho em hỏi. Giả sử có 2 mảng (A và B), cần duyệt từng phần tử một của mảng A bên mảng B. Vậy có cách nào để khi chạy vòng lặp, phần tử đã tìm thấy thì lần sau sẽ bỏ qua không ạ? (Kiểu như là một thư viện nhiều phần tử, nhưng gặp rồi thì thư viện đó loại bỏ đi phần tử đó, và nó hẹp lại dần để hạn chế vòng lặp ) - Em không nói tới dictionary đâu nhé
 
Upvote 0
Em có tự sửa lại nhưng dữ liệu chèn vào nó bị nhảy lung tung và đè lên cả header như thế này ạ

Screenshot (94).png
 
Upvote 0
Upvote 0
Nhattanktnn đã viết:
Bạn google "insert module trong vba" và tìm hiểu thêm nhé!

Liên quan tới bài kiểu này, bác Hiếu cho em hỏi. Giả sử có 2 mảng (A và B), cần duyệt từng phần tử một của mảng A bên mảng B. Vậy có cách nào để khi chạy vòng lặp, phần tử đã tìm thấy thì lần sau sẽ bỏ qua không ạ? (Kiểu như là một thư viện nhiều phần tử, nhưng gặp rồi thì thư viện đó loại bỏ đi phần tử đó, và nó hẹp lại dần để hạn chế vòng lặp ) - Em không nói tới dictionary đâu nhé
Nhấp chuột vào đây để mở rộng...
dim Arr(1 to k)

Loại bỏ phần tử thứ R với R>=1 và R<=k
Arr(R)=Arr(k)
k=k-1

vòng for: For i=1 to k
 
Upvote 0
Nhattanktnn đã viết:
Tôi nhớ đề bạn nói thế này:
Nhấp chuột vào đây để mở rộng...
Dạ vâng ban đầu đề bài như vậy nhưng em được yêu cầu sửa lại. Nhưng mò mẫm nãy giờ chưa tự sửa được code VBA vì chưa học về cấu trúc mảng. Nếu được anh sửa lại giúp em với ạ!
Bài đã được tự động gộp:

Mã: 
Option Explicit

Sub CopyPaste()
Dim ArrMPS(), ArrTD(), I&, J&, K&, Res(), iCol&
ArrTD = Sheets("TheoDoi").Range("A11:O" & Sheets("TheoDoi").Cells(Rows.Count, "D").End(xlUp).Row).Value
With Sheets("MPS")
    ArrMPS = .Range("A4:O" & .Cells(Rows.Count, "D").End(xlUp).Row).Value
    ReDim Res(1 To UBound(ArrMPS), 1 To UBound(ArrMPS, 2))
    For I = 1 To UBound(ArrMPS)
        For J = 1 To UBound(ArrTD)
            If ArrMPS(I, 4) = ArrTD(J, 4) Then
                Exit For
            End If
        Next
        If J > UBound(ArrTD) Then
            K = K + 1
            For iCol = 1 To UBound(ArrMPS, 2)
                Res(K, iCol) = ArrMPS(I, iCol)
            Next
        End If
    Next
End With
If K Then
    Sheets("TheoDoi").Rows("11:" & K + 10).Insert
    Sheets("TheoDoi").Range("A11").Resize(K, UBound(ArrMPS, 2)) = Res
End If
End Sub
À vâng em đã tìm ra được điểm sai rồi ạ. Cảm ơn anh rất nhiều!
 
Upvote 0
Nhattanktnn đã viết:
dễ hình dung
Nhấp chuột vào đây để mở rộng...
A(1 to 5)
B(1 to 10)
'Giả sử A và B chứa các phần tử là duy nhất' (1)
Dim i as long, ii as long, itemA as variant, ub2 as long
ub2 = ubound(B)
For i=1 to ubound(A)
itemA = A(i)
For ii=1 to ub2
If itemA = B(ii) Then 'tìm thấy itemA trong mảng B thì
B(ii) = B(ub2) 'Lấy phần tử cuối cùng hiện tại theo ub2 gán vào vị trí vừa tìm thấy (2)
ub2 = ub2 - 1 'và giảm kích thước mảng B đi 1 - ứng với phần tử cuối cùng vừa được dịch chuyển lại.
End if
Next ii
Next i

---
Giải thuật này có 'bug' là
Nếu (1): Mảng A gồm 5 phần tử giống nhau
và (2) xảy ra ii = ub2
Thì không rút gọn được gì. :p
 
Upvote 0
befaint đã viết:
A(1 to 5)
B(1 to 10)
'Giả sử A và B chứa các phần tử là duy nhất' (1)
Dim i as long, ii as long, itemA as variant, ub2 as long
ub2 = ubound(B)
For i=1 to ubound(A)
itemA = A(i)
For ii=1 to ub2
If itemA = B(ii) Then 'tìm thấy itemA trong mảng B thì
B(ii) = B(ub2) 'Lấy phần tử cuối cùng hiện tại theo ub2 gán vào vị trí vừa tìm thấy (2)
ub2 = ub2 - 1 'và giảm kích thước mảng B đi 1 - ứng với phần tử cuối cùng vừa được dịch chuyển lại.
End if
Next ii
Next i

---
Giải thuật này có 'bug' là
Nếu (1): Mảng A gồm 5 phần tử giống nhau
và (2) xảy ra ii = ub2
Thì không rút gọn được gì. :p
Nhấp chuột vào đây để mở rộng...
Ây da, giải thuật này hay quá bác ạ. Đôi khi muốn tìm google cũng không nghĩ ra được từ khóa là gì mà kiếm luôn :D. Cảm ơn 2 bác nhiều!
 
Upvote 0
befaint đã viết:
A(1 to 5)
B(1 to 10)
'Giả sử A và B chứa các phần tử là duy nhất' (1)
Dim i as long, ii as long, itemA as variant, ub2 as long
ub2 = ubound(B)
For i=1 to ubound(A)
itemA = A(i)
For ii=1 to ub2
If itemA = B(ii) Then 'tìm thấy itemA trong mảng B thì
B(ii) = B(ub2) 'Lấy phần tử cuối cùng hiện tại theo ub2 gán vào vị trí vừa tìm thấy (2)
ub2 = ub2 - 1 'và giảm kích thước mảng B đi 1 - ứng với phần tử cuối cùng vừa được dịch chuyển lại.
End if
Next ii
Next i

---
Giải thuật này có 'bug' là
Nếu (1): Mảng A gồm 5 phần tử giống nhau
và (2) xảy ra ii = ub2
Thì không rút gọn được gì. :p
Nhấp chuột vào đây để mở rộng...
Bác ơi đoạn itemA = A(i) em bị lỗi "Subscript out of range" ạ
 
Upvote 0
Upvote 0
snow25 đã viết:
Nếu bỏ đi đoạn code vòng lặp cuối mà dán luôn dữ liệu vào excel nó có nhanh hơn không anh nhỉ.
Nhấp chuột vào đây để mở rộng...
Bỏ vòng lặp cuối thì phải Insert dòng như bài trên của @Nhattanktnn , khi Insert thì nó tự động lấy Formats của dòng trên, tạo ra lu xu bu.
Tất cả đều chạy trong mảng nên tôi thấy không ảnh hưởng gì nhiều.
 
Upvote 0
Ba Tê đã viết:
Bỏ vòng lặp cuối thì phải Insert dòng như bài trên của @Nhattanktnn , khi Insert thì nó tự động lấy Formats của dòng trên, tạo ra lu xu bu.
Tất cả đều chạy trong mảng nên tôi thấy không ảnh hưởng gì nhiều.
Nhấp chuột vào đây để mở rộng...
Tại sao phải insert em nghĩ chỉ cần dán 2 mảng vào là được mà.Dán mảng mới trước rồi đến mảng cũ.
 
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

phanmoi688
[Xin nhờ giúp đỡ] Cách đối chiếu dữ liệu giữa hai biểu
    • Thích
2
Trả lời
28
Đọc
382
VetMini
V
tby211
Lỗi 1004 vba khi tách file trắc nghiệm sang excel
Trả lời
0
Đọc
16
tby211
tby211
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
6
Đọc
140
NguyenthiH
NguyenthiH
test1986
  • Question
HELP! Sử dụng combobox để cập nhật dữ liệu trong file Excel
Trả lời
17
Đọc
508
ngochienbmt
N
N
Hàm if, lọc dữ liệu trùng
Trả lời
6
Đọc
6K
OANHMAI123
O
Xem thêm…

Facebook

Giaiphapexcel.com

Group

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

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