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

wwdfefgg

蓝桥玄霜 发表于 2024-11-16 10:01
抄代码只抄一半的？

抄全了，，提示 子过程或函数未定义


测试.rar (1.11 MB, 下载次数: 0)

2024-11-16 10:24 上传

点击文件名下载附件

蓝桥玄霜

完整判断的例子：
别忘了抄主程序。

翁知江安

Sub paibu()
Dim i, j, k, z, m, n, irow
Dim arr, brr
irow = Sheets("1").[e65536].End(xlUp).Row
arr = Sheets("1").Range("e1:l" & irow)
For i = 2 To UBound(arr)
  If arr(i, 6) <> 1 Then
  arr(i, 5) = 100000
   Else
   arr(i, 5) = arr(i, 4)
   End If
Next
j = 3
m = arr(3, 5)
For k = 3 To UBound(arr)
  If arr(k, 5) < m Then
     j = k
     m = arr(k, 5)
    End If
Next
ReDim brr(1 To irow - 1, 1 To 2)
   brr(j - 1, 1) = arr(j, 1)
   arr(j, 7) = arr(j, 1)
   brr(j - 1, 2) = arr(j, 2)
   arr(j, 8) = arr(j, 2)
If j > 51 Then
  For z = 1 To Int((j - 1) / 50)
     brr(j - 50 * z - 1, 1) = arr(j - 50 * z, 1)
     brr(j - 50 * z - 1, 2) = arr(j - 50 * z, 2)
Next
End If
If irow - j >= 51 Then
  For z = 1 To Int((irow - j) / 50)
     brr(j + 50 * z - 1, 1) = arr(j + 50 * z, 1)
     brr(j + 50 * z - 1, 2) = arr(j + 50 * z, 2)
Next
End If
Sheets("1").[k2].Resize(UBound(brr), 2) = brr
For n = 1 To irow - 1
  If brr(n, 1) <> "" Then
  Sheets("1").Cells(n + 1, 11).Resize(1, 2).Interior.Color = vbGreen
  End If
Next
End Sub

翁知江安

供参考，欢迎批评指正

wwdfefgg

翁知江安 发表于 2024-11-16 14:08
供参考，欢迎批评指正

是针对J列数值为1的区域进行操作的。第1个数应该在第3行的，你写的程序运行出来在第2行



506        5.877850144
下一个应该是 556，，你的程序运行出来是599


还有这个，J列为空，不用处理的，怎么后面还有数？？

翁知江安

不用着急，那个J列的数据是将原来的数据移过去的。这个题目的关键是先找到最低点，看看我的找的对不对，不要着急

翁知江安

根据样本数据，是不是最后一行是最低点，如是的话，那就没有错。你再检查一下

翁知江安

不好意思，我理解错了，重新写一个

wwdfefgg

翁知江安 发表于 2024-11-17 09:32
根据样本数据，是不是最后一行是最低点，如是的话，那就没有错。你再检查一下

每个J列为1的区域对应的H列最低点的位置不一样的，有的在区域的起点，有的在终点，有的在中间，，这个得判断

wwdfefgg

翁知江安 发表于 2024-11-17 09:30
不用着急，那个J列的数据是将原来的数据移过去的。这个题目的关键是先找到最低点，看看我的找的对不对，不 ...

是的，，，这个题目的关键是先找到最低点