找到J列为1的区域对应的最高点和最低点进行判断

renkangjizhen

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)
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
End Sub

renkangjizhen

我的思路是：先依次找出各个高点与低点，然后从第一个低点向高点位移（两侧），然后，循环进入第二、第三······低点，直到结束

wwdfefgg

renkangjizhen 发表于 2024-11-18 13:39
代码在压缩文件中

第1小段107-645，最低点在107，你写的程序第1个数是156

wwdfefgg

翁知江安 发表于 2024-11-18 09:57
你真的很着急？

也不是非常着急，过几天要用

wwdfefgg

就把J列为1的区域对应的标高检测一下，拆分成趋势要么递增，要么递减的小区域，每个小区域不能重叠，每个小区域从最低点开始布出水口，间距50m，最后一段到最高点的距离必须小于50m，布完如果两个出水口的间距小于10m，保留第1个，删除第2个。

renkangjizhen

就是这么设计的。但是“两个出水口的间距小于10m，保留第1个，删除第2个。”当时没有发现这个条件

wwdfefgg

renkangjizhen 发表于 2024-11-18 16:15
就是这么设计的。但是“两个出水口的间距小于10m，保留第1个，删除第2个。”当时没有发现这个条件

麻烦改一下

还有 第1小段107-645，最低点在107，你写的程序第1个数是156

wwdfefgg

renkangjizhen 发表于 2024-11-18 16:15
就是这么设计的。但是“两个出水口的间距小于10m，保留第1个，删除第2个。”当时没有发现这个条件

麻烦改一下，谢谢了

renkangjizhen

排水口的位置已经有了，算算临近出口之间的距离，再加一个判断语句即可

wwdfefgg

renkangjizhen 发表于 2024-11-20 08:07
排水口的位置已经有了，算算临近出口之间的距离，再加一个判断语句即可

主要是第一个出水口的位置不对，下面跟着全错了