Sub 找高低点()
Dim i%, arr(1 To 100, 1 To 2), brr(1 To 100, 1 To 2), m%, n%, x%, k%, d, y%, z%, crr(1 To 1000, 1 To 2),w%
Set d = CreateObject("scripting.dictionary")
If Cells(2, "h") < Cells(3, "h") Then
arr(1, 1) = Cells(2, "e"): arr(1, 2) = Cells(2, "f"): m = 1
Else
brr(1, 1) = Cells(2, "e"): brr(1, 2) = Cells(2, "f"): n = 1
End If
For i = 3 To [e65532].End(3).Row
d(Cells(i, "e").Value) = Cells(i, "f")
If Cells(i - 1, "h") < Cells(i, "h") And Cells(i + 1, "h") < Cells(i, "h") Then
n = n + 1: brr(n, 1) = Cells(i, "e"): brr(n, 2) = Cells(i, "f")
End If
If Cells(i - 1, "h") > Cells(i, "h") And Cells(i + 1, "h") > Cells(i, "h") Then
m = m + 1: arr(m, 1) = Cells(i, "e"): arr(m, 2) = Cells(i, "f")
End If
Next
For x = 1 To m
If arr(x, 1) < brr(x, 1) Then
For y = arr(x, 1) To brr(x, 1) Step 50
k = k + 1: crr(k, 1) = y: crr(k, 2) = d(y)
Next
z = (arr(x + 1, 1) - brr(x, 1)) Mod 50
For y = brr(x, 1) + z To arr(x + 1, 1) Step 50
k = k + 1: crr(k, 1) = y: crr(k, 2) = d(y)
Next
End If
If arr(x, 1) > brr(x, 1) Then
z = (arr(x + 1, 1) - brr(x, 1)) Mod 50
For y = brr(x, 1) + z To arr(x, 1) Step 50
k = k + 1: crr(k, 1) = y: crr(k, 2) = d(y)
Next
For y = arr(x, 1) To brr(x + 1, 1) Step 50
k = k + 1: crr(k, 1) = y: crr(k, 2) = d(y)
Next
End If
Next
[k2].Resize(k, 2) = crr
For w= 2 to ubound(crr)
If crr(w,1)-crr(w-1,1)<10 then
Range(cells(w,11),cells(w,12)).clearcontents
next
End Sub
|
楼主: wwdfefgg
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-11-20 08:20
楼主
