Sub DanhSachNhanQua()
Dim Rng As Range, Cls As Range
Dim Rws As Long, J As Long, lRw As Long
With Sheets("DS 1")
Rws = [C9999].End(xlUp).Row
For J = 3 To Rws
If .Cells(J, "A").Value <> Space(0) Then
lRw = .Cells(J, "A").End(xlDown).Offset(-1).Row
If lRw > Rws Then lRw = Rws
Set Rng = .Range(.Cells(J, "A"), .Cells(lRw, "A")) '.Resize(, 10) '
For Each Cls In Rng.Offset(, 9)
If Cls.Value <> Space(0) Then
MsgBox "Không Chép Vùng Này: " & Rng.Address, , "Xin Chào!"
Exit For
End If
Next Cls
End If
Next J
End With
End SubEm thử nhưng ko được. Bác xem lại giúp em với
Bác đừng hiểu lầm ạ. Em không có ý gì cả đâu. Được bác hỗ trợ em rất mừng nhưng thực sự là em cũng áp dụng như lâu nay (ấn ALT + f11 để dán đoạn macro bác cho rồi f5) mà không thấy ra kết quả gì nên em nhờ bác xem lại giúp em ạ.
Đi nhậu đã bác, các chiến hữu đang chờ.
Đang lọc sơ bộ, cứ bình tĩnh đã.
(1) Đúng vậy;
Bạn thử tham khảo. .
Vâng, số thứ tự tăng dần theo nhóm đối tượng XX và XY ạ (trong bảng có 9 hộ thuộc đối tượng XX và 24 hộ thuộc đối tượng XY). Hộ có 1 người nhận quà được tính là "Hộ đã nhận quà"
Cảm ơn bác, file bác gửi em chạy thấy được rồi ạ
Có thể có một số trường hợp chưa có trong file này nên khi thay đổi dữ liệu sẽ có lỗi.
Đã thấy côt Đối tượng, thử code này"
Sub DanhSachChuaNhanQua()
Dim lr&, i&, j&, k&, Sarr As Variant, Rarr As Variant
Dim Dic As Object, ID$
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("DS 1")
lr = .Range("B" & Rows.Count).End(xlUp).Row
Sarr = .Range("A3:K" & lr).Value
ReDim Rarr(1 To lr, 1 To 10)
End With
For i = 1 To UBound(Sarr, 1)
If Sarr(i, 1) <> "" Then ID = Sarr(i, 1) & Sarr(i, 8) ' ghi so ID
Sarr(i, 11) = ID
If Sarr(i, 10) <> "" Then Dic.Item(ID) = "Da nhan qua" ' Da nhan qua
Next i
' trich loc
For i = 1 To UBound(Sarr, 1)
If Dic.Exists(Sarr(i, 11)) = False Then
k = k + 1
For j = 1 To 10
Rarr(k, j) = Sarr(i, j)
Next j
End If
Next i
With Sheets("DS cac ho chua nhan qua")
' xoa du lieu
.UsedRange.Offset(2).ClearContents
' ghi ket qua
If k > 0 Then .Range("A3").Resize(k, 10) = Rarr
End With
End Sub
