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

trieucuong.ise17 · 5/3/21

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 đỡ!

Nhattanktnn · 5/3/21

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 đỡ!

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?

trieucuong.ise17 · 5/3/21

Nhattanktnn đã viết:
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?

Vâng anh nói đúng rồi ấy ạ!

Nhattanktnn · 5/3/21

trieucuong.ise17 đã viết:
Vâng anh nói đúng rồi ấy ạ!

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

HieuCD · 5/3/21

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

Dữ liệu nhiều chạy mệt lắm

trieucuong.ise17 · 5/3/21

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 ạ?

Nhattanktnn · 5/3/21

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 ạ?

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

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é

trieucuong.ise17 · 5/3/21

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 ạ

Nhattanktnn · 5/3/21

trieucuong.ise17 đã viết:
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 ạ

View attachment 254915

Tôi nhớ đề bạn nói thế này:

trieucuong.ise17 đã viết:
chèn lên đầu các đơn hàng (hàng thứ 3)

HieuCD · 5/3/21

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é

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

trieucuong.ise17 · 5/3/21

Nhattanktnn đã viết:
Tôi nhớ đề bạn nói thế này:

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: 5/3/21

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!

Nhattanktnn · 5/3/21

HieuCD đã viết:
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

Bác có bài tập cụ thể nào cho em dễ hình dung tí không?

HieuCD · 5/3/21

Nhattanktnn đã viết:
Bác có bài tập cụ thể nào cho em dễ hình dung tí không?

Tạo mảng ngẫu nhiên không trùng có giá trị từ 1 tới k

befaint · 5/3/21

Nhattanktnn đã viết:
dễ hình dung

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ì.

Nhattanktnn · 5/3/21

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ì.

Â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

. Cảm ơn 2 bác nhiều!

trieucuong.ise17 · 6/3/21

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ì.

Bác ơi đoạn itemA = A(i) em bị lỗi "Subscript out of range" ạ

Ba Tê · 9/3/21

trieucuong.ise17 đã viết:
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 ạ?

Dùng "dao mổ Trâu, chém loạn xà ngầu" thử xem:

snow25 · 9/3/21

HieuCD đã viết:
Dữ liệu nhiều chạy mệt lắm

Mệt thì nghỉ anh ơi.

Ba Tê đã viết:
Dùng "dao mổ Trâu, chém loạn xà ngầu" thử xem:

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ỉ.

Ba Tê · 9/3/21

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ỉ.

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.

snow25 · 9/3/21

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.

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ũ.

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

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

Thành viên gắn bó

Chuyên gia GPE

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

Thành viên gắn bó

Chuyên gia GPE

Thành viên mới

Thành viên gắn bó

Chuyên gia GPE

|||||||||||||

Thành viên gắn bó

Thành viên mới

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên gạo cội

Cạo Rồi Khỏi Gội

Thành viên gạo cội