Xin giup em code copy dòng có điều kiện với ạ (1 người xem)

[tn001]

Em có 1 file excel gồm 4 sheet như sau: DU LIEU, DIEU KIEN, KET QUA, GHI CHU DANH SACH KHONG CO (file dinh kem)
Em muốn copy một số dữ liệu theo dòng từ sheet DU LIEU theo điều kiện ở Sheet DIEU KIEN sang Sheet KET QUA. Nếu một số dữ liệu ở Sheet DIEU KIEN không có (không thỏa mãn) thì ghi sang Sheet GHI CHU DANH SACH KHONG CO.
File dữ liệu em gửi đính kèm, dữ liệu với số lượng lớn, trên 10000 dòng. EM xin cảm ơn nhiều ạ!

 

[viehoai]

Em có 1 file excel gồm 4 sheet như sau: DU LIEU, DIEU KIEN, KET QUA, GHI CHU DANH SACH KHONG CO (file dinh kem)
Em muốn copy một số dữ liệu theo dòng từ sheet DU LIEU theo điều kiện ở Sheet DIEU KIEN sang Sheet KET QUA. Nếu một số dữ liệu ở Sheet DIEU KIEN không có (không thỏa mãn) thì ghi sang Sheet GHI CHU DANH SACH KHONG CO.
File dữ liệu em gửi đính kèm, dữ liệu với số lượng lớn, trên 10000 dòng. EM xin cảm ơn nhiều ạ!

Bạn test file xem đúng ý bạn không nhé

 

[tn001]

Em cảm ơn anh nhiều! Rất chuẩn với công việc em cần ạ! Chúc anh sức khỏe, vui vẻ và thành công
Chúc 4rum ngày càng phát triển

 

[tn001]

Em vẫn có thêm một chút yêu cầu là: Nếu bên sheet DU LIEU có nhiều dòng thỏa mãn sheet DIEU KIEN thì copy hết sang sheet KET QUA
Trong bài giúp đỡ của anh viehoai dữ liệu có nhiều dòng thỏa mãn thì copy dòng đầu tiên ạ. Mong các anh chị giúp đỡ em thêm! Em cảm ơn!

 

[Ba Tê]

Em vẫn có thêm một chút yêu cầu là: Nếu bên sheet DU LIEU có nhiều dòng thỏa mãn sheet DIEU KIEN thì copy hết sang sheet KET QUA
Trong bài giúp đỡ của anh viehoai dữ liệu có nhiều dòng thỏa mãn thì copy dòng đầu tiên ạ. Mong các anh chị giúp đỡ em thêm! Em cảm ơn!

Không hiểu Sheet Ghi chú gì đó lấy dữ liệu nào.
Thử cái này xem.

 

[viehoai]

Em vẫn có thêm một chút yêu cầu là: Nếu bên sheet DU LIEU có nhiều dòng thỏa mãn sheet DIEU KIEN thì copy hết sang sheet KET QUA
Trong bài giúp đỡ của anh viehoai dữ liệu có nhiều dòng thỏa mãn thì copy dòng đầu tiên ạ. Mong các anh chị giúp đỡ em thêm! Em cảm ơn!

Bạn bỏ cặp lệnh
Goto NextK
...
NextK:
là được

Sub Loc()
Dim Arr(), ArrDK(), ArrKDK(), ArrKQDK(), ArrKQKDK()
Dim i As Long, j As Long, k As Long, t As Long, s As Long
Dim Tmp As Byte
On Error GoTo Thoat
Arr = Sheet1.Range("A2:E20000").Value
ArrDK = Sheet2.Range("A2:A100").Value
ReDim ArrKQDK(1 To UBound(ArrDK), 1 To UBound(Arr, 2))
ReDim ArrKQKDK(1 To UBound(ArrDK), 1 To 1)
For k = 1 To UBound(ArrDK)
If ArrDK(k, 1) = "" Then Exit For
Tmp = 0
  For i = 1 To UBound(Arr)
    If Arr(i, 1) = ArrDK(k, 1) Then
      s = s + 1
      Tmp = 1
      For j = 1 To UBound(Arr, 2)
        ArrKQDK(s, j) = Arr(i, j)
      Next
    End If
  Next
  If Tmp = 0 Then
      t = t + 1
      ArrKQKDK(t, 1) = ArrDK(k, 1)
  End If
Next
Sheet3.Range("A2:E1000").ClearContents
Sheet4.Range("A2:A1000").ClearContents
Sheet3.Range("A2").Resize(s, UBound(Arr, 2)).Value = ArrKQDK
Sheet4.Range("A2").Resize(t).Value = ArrKQKDK
Thoat:
End Sub

 

[tn001]

Thanks Anh, em làm được rồi, cảm ơn anh rất nhiều.
@Ba Tê, sao code của anh em không chạy được vậy? Chạy không báo lỗi cũng không có kết quả gì cả ạ

 

[Ba Tê]

Thanks Anh, em làm được rồi, cảm ơn anh rất nhiều.
@Ba Tê, sao code của anh em không chạy được vậy? Chạy không báo lỗi cũng không có kết quả gì cả ạ

Thiếu cái này trong sheet1.

Private Sub CommandButton1_Click()
GPE
End Sub

 

[tn001]

Thiếu cái này trong sheet1.

Private Sub CommandButton1_Click()
GPE
End Sub

he he, em ngây ngô ghê. Thanks anh, cũng là cái em cần trong công việc
cảm ơn các anh, cảm ơn GPE nhiều!