检测K列和M列的异常数

wwdfefgg

yynrzwh 发表于 2024-11-29 15:58
Sub 标色()

With Sheet1

标记的位置有点问题，应该标到我框选的位置

笨鸟飞不高

wwdfefgg

笨鸟飞不高 发表于 2024-11-30 10:04

麻烦把代码贴上来，我测试一下哦

renkangjizhen

有数据陷阱，没那么简单

准提部林

找上波或下波中間的異常點///
Xl0000311.rar (407.36 KB, 下载次数: 2)

2024-12-1 16:09 上传

点击文件名下载附件

过客fppt

1. Sub DetectAndHighlightAnomalies()
   
2.     Dim lastRow As Long
   
3.     Dim i As Long
   
4.     Dim isIncreasing As Boolean
   
5.     Dim isDecreasing As Boolean
   
6.     Dim rangeToCheck As Range
   
7.     Dim firstAnomalyCell As Range
   
8.    
   
9.     ' 获取K列和M列最后一行有数据的行号
   
10.     lastRow = Cells(Rows.Count, "K").End(xlUp).Row
    
11.    
    
12.     ' 设置要检查的区域为K列和M列的数据区域
    
13.     Set rangeToCheck = Union(Range("K1:K" & lastRow), Range("M1:M" & lastRow))
    
14.    
    
15.     ' 遍历区域中的每个单元格，检查数据趋势
    
16.     For i = 2 To lastRow
    
17.         If Cells(i, "K") > Cells(i - 1, "K") Then
    
18.             isIncreasing = True
    
19.             isDecreasing = False
    
20.         ElseIf Cells(i, "K") < Cells(i - 1, "K") Then
    
21.             isIncreasing = False
    
22.             isDecreasing = True
    
23.         End If
    
24.         
    
25.         If Cells(i, "M") > Cells(i - 1, "M") Then
    
26.             If Not isIncreasing Then
    
27.                 If firstAnomalyCell Is Nothing Then
    
28.                     Set firstAnomalyCell = Cells(i, "K")
    
29.                     If Cells(i, "K") = Cells(i, "M") Then
    
30.                         Set firstAnomalyCell = Cells(i, "M")
    
31.                     End If
    
32.                 End If
    
33.                 Cells(i, "K").Interior.Color = RGB(0, 255, 0)
    
34.                 Cells(i, "M").Interior.Color = RGB(0, 255, 0)
    
35.             End If
    
36.             isIncreasing = True
    
37.             isDecreasing = False
    
38.         ElseIf Cells(i, "M") < Cells(i - 1, "M") Then
    
39.             If not isDecreasing Then
    
40.                 If firstAnomalyCell Is Nothing Then
    
41.                     Set firstAnomalyCell = Cells(i, "K")
    
42.                     If Cells(i, "K") = Cells(i, "M") Then
    
43.                         Set firstAnomalyCell = Cells(i, "M")
    
44.                     End If
    
45.                 End If
    
46.                 Cells(i, "K").Interior.Color = RGB(0, 255, 0)
    
47.                 Cells(i, "M").Interior.Color = RGB(0, 255, 0)
    
48.             End If
    
49.             isIncreasing = False
    
50.             isDecreasing = True
    
51.         End If
    
52.     End For
    
53.    
    
54.     ' 如果找到异常单元格，定位到第一个异常单元格
    
55.     If Not firstAnomalyCell Is Nothing Then
    
56.         firstAnomalyCell.Select
    
57.     End If
    
58. End Sub
    
59. 
    
60. Sub ClearColors()
    
61.     Dim lastRow As Long
    
62.     Dim rangeToClear As Range
    
63.    
    
64.     ' 获取K列和M列最后一行有数据的行号
    
65.     lastRow = Cells(Rows.Count, "K").End(xlUp).Row
    
66.    
    
67.     ' 设置要清除颜色的区域为K列和M列的数据区域
    
68.     Set rangeToClear = Union(Range("K1:K" & lastRow), Range("M1:M" & lastRow))
    
69.    
    
70.     ' 清除区域内单元格的颜色
    
71.     rangeToClear.Interior.ColorIndex = xlColorIndexNone
    
72. End Sub

复制代码