|
- Sub test()
- Application.ScreenUpdating = False
- Set d = CreateObject("scripting.dictionary")
- With Sheet1
- arr = .Range("A1").CurrentRegion
- For i = 3 To UBound(arr)
- If i < UBound(arr) Then
- If arr(i, 2) > arr(i - 1, 2) And arr(i, 2) > arr(i + 1, 2) Then
- n = n + 1
- d(n) = Array(arr(i, 1), arr(i, 2))
- ElseIf arr(i, 2) < arr(i - 1, 2) And arr(i, 2) < arr(i + 1, 2) Then
- n = n + 1
- d(n) = Array(arr(i, 1), arr(i, 2))
- End If
- ElseIf i = UBound(arr) And arr(i, 2) > arr(i - 1, 2) Or arr(i, 2) < arr(i - 1, 2) Then
- d(n + 1) = Array(arr(i, 1), arr(i, 2))
- End If
- Next
- .Range("F3").Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items))
- End With
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|