检查遗漏

quqiyuan

代码如下。。。


Sub test()
    With Sheet1
        r = .Cells(Rows.Count, 5).End(3).Row
        .[m6].Resize(r - 5).ClearContents
        ReDim brr(1 To 10000, 1 To 2)
        n = 0: m = 0
        For i = 6 To r - 1
            If .Cells(i, 5).Interior.Color = .Cells(i + 1, 5).Interior.Color Then
                If .Cells(i, 5) <> 0 And n = 0 Then
                    m = m + 1
                    brr(m, 1) = "第" & i & "行": brr(m, 2) = "少0"
                ElseIf .Cells(i + 1, 5) <> .Cells(i, 5) + 1 Then
                    m = m + 1
                    brr(m, 1) = "第" & i + 1 & "行": brr(m, 2) = "不连续"
                End If
                If n = 0 And .Cells(i + 1, 5) <> .Cells(i, 5) + 1 Then
                    m = m + 1
                    brr(m, 1) = "第" & i + 1 & "行": brr(m, 2) = "不连续"
                End If
                n = n + 1
            Else
                n = 0
            End If
        Next
        .[t6].Resize(m, 2) = brr
    End With
    Beep
End Sub

ddz79101

quqiyuan 发表于 2024-10-13 11:29
稍作修改即可，仅供参考。。。

谢谢老师！完美了。

ddz79101

quqiyuan 发表于 2024-10-13 11:56
更新了一下，如果第一行跟第二行不连续有少0，有缺陷，仅供参考。。

谢谢老师的加餐，成功

ddz79101

quqiyuan 发表于 2024-10-13 11:57
代码如下。。。

老师！实际操作中发现问题，久时未解。请帮忙看看sheet2

quqiyuan

ddz79101 发表于 2024-10-13 17:08
老师！实际操作中发现问题，久时未解。请帮忙看看sheet2

就是正常的话，要处理一下，这个以前没考虑，现在改过来，也没有错误了。。。