区间判断并取值

cg1221

通过输入段落的起终点，判断本段落在台账的区间位置。并计算出相应段落长度。上次psxk3535老师已经帮我写过一次了，但是有个Bug，当输入的起终点在同一段落时会返回错误值，比如 台账上某段落是500-400，当我输入480-450进行计算时，就会出错。我对VBA不太懂，哪位老师帮我改改。谢谢

liulang0808

Sub 按钮1_Click()
    x = [a3]
    y = [b3]
    Application.ScreenUpdating = False
    Sheets("数据查询表1降序").UsedRange.Offset(4).ClearContents
    arr = Sheets("台账1降序").UsedRange
    r = 0
    For j = 3 To UBound(arr)
        If x >= arr(j, 4) And arr(j, 2) >= x Then
            r = r + 1
            For i = 1 To UBound(arr, 2)
                arr(r, i) = arr(j, i)
            Next i
            arr(r, 2) = x
            x = arr(j, 4)
            arr(r, 5) = arr(r, 2) - arr(r, 4)
            If y >= arr(j, 4) Then
                arr(r, 4) = y
                arr(r, 5) = arr(r, 2) - arr(r, 4)
                Exit For
            End If
        End If
    Next j
    If r > 0 Then
        [a5].Resize(r, UBound(arr, 2)) = arr
    End If
End Sub

liulang0808

模拟了一个结果供参考。。。。。

cg1221

liulang0808 发表于 2022-5-14 12:57
模拟了一个结果供参考。。。。。

这个代码还要简洁些，感谢liulang老师的帮助。老师能再写个升序的吗？

liulang0808

cg1221 发表于 2022-5-14 21:54
这个代码还要简洁些，感谢liulang老师的帮助。老师能再写个升序的吗？

参考降序，楼主自己改下把

cg1221

liulang0808 发表于 2022-5-14 21:56
参考降序，楼主自己改下把

看不太懂VBA，我从下午就在研究这个代码
    x = [a3]   //变量X=查询的起点
    y = [b3]   //变量Y=查询的终点
    Application.ScreenUpdating = False  //不让刷新
    Sheets("数据查询表1降序").UsedRange.Offset(4).ClearContents //删除数据查询表1降序 第4行以下的数据
    arr = Sheets("台账1降序").UsedRange  //数组arr=整个台账1降序
    r = 0  //变量r赋值0
    For j = 3 To UBound(arr)  //for循环，从3开始到aar集合结束
        If x >= arr(j, 4) And arr(j, 2) >= x Then  //如果 查询起点 大于等于（某段落终点） （某段落起点）大于等于 查询起点
            r = r + 1 //那么变量r+1
            For i = 1 To UBound(arr, 2) //看不懂了............
                arr(r, i) = arr(j, i)
            Next i
            arr(r, 2) = x
            x = arr(j, 4)
            arr(r, 5) = arr(r, 2) - arr(r, 4)
            If y >= arr(j, 4) Then
                arr(r, 4) = y
                arr(r, 5) = arr(r, 2) - arr(r, 4)
                Exit For
            End If
        End If
    Next j
    If r > 0 Then
        [a5].Resize(r, UBound(arr, 2)) = arr
    End If
End Sub

liulang0808

cg1221 发表于 2022-5-14 22:07
看不太懂VBA，我从下午就在研究这个代码
    x = [a3]   //变量X=查询的起点
    y =    //变量Y= ...

对比降序，就是一个逻辑上的修改