Xin code VBA Tìm kiếm, liệt kê đối tượng thiếu

[bangpho]

Mình có 1 danh sách gồm 2 cộT COT1 có những giá trị A, B, C... COT2 có những giá trị là số tự nhiên 1, 2, 3...
Mình muốn nhờ ACE giúp viết hộ code VBA để tìm và liệt ra những dòng có số tự nhiên bên COT2 bị thiếu.
Cám ơn!

View more random threads:

• Hàm DATEDIF không ra kết quả
• Ai chỉ giúp mình cách tạo llist năm hạch toán này với
• Ẩn dòng trong excel.
• xuất nhập tồn
• Hỏi cập nhật dữ liệu tự động giữa các sheet!
• lỗi excel
• Tạo một cột số không trùng nhau từ 3 cột số trở lên
• Xin giúp đỡ về cài pass khi gởi phiếu lương bằng Mail Merge
• cách phục hồi dữ liệu bi nhiễm vi rút có gắn đuôi hsxflnc
• Giúp đỡ code copy từ nhiều sheet về một sheet tổng hợp và xoá nội dung cũ

[ntthu.831]

Mình có 1 danh sách gồm 2 cộT COT1 có những giá trị A, B, C... COT2 có những giá trị là số tự nhiên 1, 2, 3...
Mình muốn nhờ ACE giúp viết hộ code VBA để tìm và liệt ra những dòng có số tự nhiên bên COT2 bị thiếu.
Cám ơn!

cái này ko chơi nhảy cóc nha

Sub sothieu()
Dim arr, kq(1 To 60000, 1 To 2) As Variant
arr = [a2].Resize([a60000].End(3).Row - 1, 2).Value
For i = 2 To UBound(arr)
    If arr(i - 1, 1) = arr(i, 1) Then
        If arr(i - 1, 2) <> arr(i, 2) - 1 Then
            k = k + 1
            kq(k, 1) = arr(i, 1)
            kq(k, 2) = arr(i, 2) - 1
        End If
    Else
        If arr(i, 2) <> 1 Then
            k = k + 1
            kq(k, 1) = arr(i, 1)
            kq(k, 2) = arr(i, 2) - 1
        End If
    End If
Next
        
If k Then [f10].Resize(k, 2).Value = kq
End Sub

[sutuhong123]

Cám ơn bạn, nhưng mình cần cả "nhảy cóc" nữa bạn ah. Mỉnh thử thì thấy Thiếu 1, 2 bắt đầu từ 3 thì chỉ thấy bảo thiếu 2 thôi. Bạn cố gắng sửa giúp mình với được không?
Cám ơn!

[anhdjen]

Mình tìm trên diễn đàn được đoạn code này nhưng chỉ tìm được giá trị thiếu trong 1 cột thôi. Bạn giúp mình sửa theo được không.
Sub MaxNum()
Dim jJ As Long, Rng As Range, sRng As Range

Set Rng = Range([b3], [b65500].End(xlUp))
For jJ = 1 To WorksheetFunction.Max(Rng)
Set sRng = Rng.Find(jJ, , xlFormulas, xlWhole)
If sRng Is Nothing Then [l65500].End(xlUp).Offset(1).Value = jJ
Next jJ
End Sub

[tientho90]

[QUOTE="Let'GâuGâu"]cái này ko chơi nhảy cóc nha

Sub SoThieu()Dim Arr, Kq(1 To 65536, 1 To 2) As Variant, A As String, B As Long, i As Long, j As Long, k As LongArr = Range([A2], [B65536].End(xlUp)).ValueFor i = 1 To UBound(Arr, 1)    If Arr(i, 1) <> A Then        B = 1        A = Arr(i, 1)    End If    For j = B To Arr(i, 2) - 1        k = k + 1        Kq(k, 1) = A        Kq(k, 2) = j    Next    B = Arr(i, 2) + 1NextIf k > 0 Then [F3].Resize(k, 2).Value = KqEnd Sub  

[bietthugeleximco]

Cám ơn bạn, nhưng mình cần cả "nhảy cóc" nữa bạn ah. Mỉnh thử thì thấy Thiếu 1, 2 bắt đầu từ 3 thì chỉ thấy bảo thiếu 2 thôi. Bạn cố gắng sửa giúp mình với được không?
Cám ơn!

đã có code của anh HuuThangBD, lỡ dzọc rồi, thôi đưa lên luôn cho bạn tham khảo nha

Sub SoThieu()
Dim Arr, Kq(1 To 60000, 1 To 2) As Variant, i, k, cnt As Long
Arr = [A2].Resize([a60000].End(3).Row - 1, 2).Value
cnt = 1
For i = 1 To UBound(Arr) - 1
    If Arr(i, 1) = Arr(i + 1, 1) Then
    If cnt < Arr(i + 1, 2) - 1 Then
            Do
                If cnt = Arr(i, 2) Then Exit Do
                k = k + 1
                Kq(k, 1) = Arr(i + 1, 1)
                Kq(k, 2) = cnt
                cnt = cnt + 1
            Loop Until cnt = Arr(i + 1, 2) - 1
    End If
    Else
        cnt = 0
    End If
        cnt = cnt + 1
Next
  [f10:g10000].Clear
If k Then [f10].Resize(k, 2).Value = Kq
End Sub

[nna19x7]

Cám ơn mọi người nhiều nhé. Mình làm được rồi

[angelareview]

Nếu thiếu nhiều số liên tục thì code này không đúng.
Bạn chủ topic thử code này xem.

<div class="bbcode_container">
<div class="bbcode_description">PHP Code:

</div>
</div>
</div>
Code này của bạn đúng với trường hợp số tự nhiên tại cột 2 phải xếp theo thứ tự từ bé đến lớn. Nếu không theo thứ tự thì không được bạn ah( Cot2 : 5 2 3 6 thì nó báo thiếu 1 2 3 4 4 ) . Bạn xem rồi sửa giúp mình nhé.
Mình thấy code MaxNum kia tìm đúng hơn nhưng mình không sửa theo được. Bạn xem rồi sửa giúp mình với nhé.

Sub MaxNum()
Dim jJ As Long, Rng As Range, sRng As Range

Set Rng = Range([b3], [b65500].End(xlUp))
For jJ = 1 To WorksheetFunction.Max(Rng)
Set sRng = Rng.Find(jJ, , xlFormulas, xlWhole)
If sRng Is Nothing Then [l65500].End(xlUp).Offset(1).Value = jJ
Next jJ
End Sub

[seobookin]

Code này của bạn đúng với trường hợp số tự nhiên tại cột 2 phải xếp theo thứ tự từ bé đến lớn. Nếu không theo thứ tự thì không được bạn ah( Cot2 : 5 2 3 6 thì nó báo thiếu 1 2 3 4 4 ) . Bạn xem rồi sửa giúp mình nhé.
Mình thấy code MaxNum kia tìm đúng hơn nhưng mình không sửa theo được. Bạn xem rồi sửa giúp mình với nhé.

Sub MaxNum()
Dim jJ As Long, Rng As Range, sRng As Range

Set Rng = Range([b3], [b65500].End(xlUp))
For jJ = 1 To WorksheetFunction.Max(Rng)
Set sRng = Rng.Find(jJ, , xlFormulas, xlWhole)
If sRng Is Nothing Then [l65500].End(xlUp).Offset(1).Value = jJ
Next jJ
End Sub

Cũng do file giả lập của bạn không tổng quát. Bạn hãy tạo một file giả lập sao cho tổng quát hết tất cả các trường hợp. Sửa lắc nhắc mất thời gian lắm.
Chú ý: Cột A có được sắp xếp theo nhóm không hay cũng lộn xộn?

[duykhoakt2014]

SORY! Đến lúc mình đưa dữ liệu vào mới gặp trường hợp như vậy. cột A sắp xếp theo nhóm chỉ có cột B bị đảo sắp xếp thôi bạn