检测K列和M列的异常数

wwdfefgg · 发表于 2024-11-29 11:09

本帖最后由 wwdfefgg 于 2024-11-29 11:15 编辑

K列和M列连续的区域要么递增，要么递减

比如这种是递增的；
1002.192
1002.195
1002.198
1002.201
1002.204
1002.207
1002.210
1002.213
1002.216
1002.219

比如这种是递减的；
1002.479
1002.459
1002.439
1002.419
1002.399
1002.378
1002.358
1002.337
1002.317
1002.296
1002.276
1002.255

现在需要对其中的异常数据进行检测

主要检测：

递增的区域，出现某个单元格递减的

1010.778
1010.792
1010.807
1010.821
1010.835
1010.819 --------这个是异常数据，前后都是递增的，突然出现1个递减的，异常数
1010.863
1010.877
1010.891
1010.904
1010.918
1010.931
1010.945
1010.958
1010.971
1010.984

或

递减的区域，出现某个单元格递增的

997.093
997.073
997.058
997.042
997.080 ---------这个是异常数据，前后都是递减的，突然出现1个递增的，异常数
997.011
996.996
996.980
996.965
996.949
996.934
996.958 ---------这个是异常数据，前后都是递减的，突然出现1个递增的，异常数
996.903
996.883

需要做一个VBA代码，点击检测按钮进行检测，检测完毕后，

定位到出问题的单元格，并将该单元格染成绿色

如果有好几个出问题，定位到第1个出问题的单元格即可。

再次点击按钮，需要把K列和M列之前染的颜色去掉（不要改变其他列的颜色，仅对K列和M列操作），如果还有异常数，再定位，再染色。

数据检测.rar (463.94 KB, 下载次数: 11)

chxw68 · 发表于 2024-11-29 11:22

Sub test()
Dim r%, i%
Dim arr, brr
With Worksheets("sheet1")
r = .Cells(.Rows.Count, 11).End(xlUp).Row
arr = .Range("k3:m" & r)
For i = 2 To UBound(arr) - 1
If Sgn(arr(i, 1) - arr(i - 1, 1)) = Sgn(arr(i, 1) - arr(i + 1, 1)) Then
.Cells(2 + i, 11).Interior.ColorIndex = 4
End If
If Sgn(arr(i, 3) - arr(i - 1, 3)) = Sgn(arr(i, 3) - arr(i + 1, 3)) Then
.Cells(2 + i, 13).Interior.ColorIndex = 4
End If
Next
End With
End Sub

复制代码

chxw68 · 发表于 2024-11-29 11:23

结果不一定正确。

wwdfefgg · 发表于 2024-11-29 11:30

本帖最后由 wwdfefgg 于 2024-11-29 11:34 编辑

chxw68 发表于 2024-11-29 11:23
结果不一定正确。

处在递增和递减分界线处的不用标记，比如这个不用标记

下面这个标记999.508即可，，999.506不用标记

还有为减少手工工作量，检测完毕后，光标需定位到第一个异常单元格

cysczhumh · 发表于 2024-11-29 11:37

太简单了，在B2单元格输入=A2>A1，回车，下拉，出现FALSE的，就是异常数据。然后筛选，标红。

yynrzwh · 发表于 2024-11-29 11:45

wwdfefgg · 发表于 2024-11-29 14:20

yynrzwh 发表于 2024-11-29 11:45

麻烦发一下代码，我测试一下

wwdfefgg · 发表于 2024-11-29 14:21

cysczhumh 发表于 2024-11-29 11:37
太简单了，在B2单元格输入=A2>A1，回车，下拉，出现FALSE的，就是异常数据。然后筛选，标红。

没这么简单。。。。

wwdfefgg · 发表于 2024-11-29 15:31

求高手解答。。。。。。

yynrzwh · 发表于 2024-11-29 15:58

Sub 标色()

With Sheet1
For col = 11 To 13 Step 2
      lr = .Cells(Rows.Count, col).End(3).Row
      .Cells(3, col).Resize(lr - 2).Interior.ColorIndex = 0
      ar = .Cells(1, col).Resize(lr)
      For i = 5 To lr - 2
         If ar(i - 1, 1) > ar(i, 1) Then
            If ar(i, 1) < ar(i + 1, 1) And ar(i + 1, 1) > ar(i + 2, 1) Then
                  .Cells(i, col).Interior.ColorIndex = 6
                  .Cells(i, col).Select
                  Exit For
            End If
         Else
            If ar(i, 1) > ar(i + 1, 1) And ar(i + 1, 1) < ar(i + 2, 1) Then
                  .Cells(i, col).Interior.ColorIndex = 6
                  .Cells(i, col).Select
                  Exit For
            End If
         End If
      Next
Next
End With

End Sub

		自动登录	找回密码
密码			免费注册

[求助] 检测K列和M列的异常数