Question

excel vba问题，关于如何按照给定条件进行表格分割

黄色表格中，A列为“2”的行有四个（称为“2”行），分别为“16-20”，“30-37”，“70-80”，“101-105”。现在需要进行判断，当相邻的两个“2”行之间的间距≤10时，则“2”行之间的“1”行不进行拆分（例如第一个“2”行的终值是20，第二个“2”行的初值是30，两个“2”行的间距为10，因此中间的“1”行不进行拆分）；当相邻的两个“2”行之间的间距大于10时，则将两个“2”行之间的“1”行进行拆分，拆分方法为：将该区间起始端的“2”行的终值＋5，作为一个拆分点；将该区间终止端的“2”行的初值-5，作为一个拆分点（例如第二个“2”行的终值为37，第三个“2”行的终值为70，两个“2”行之间的间距为33，因此需要将中间的“1”行进行拆分。将该区间起始端“2”行的终值37加上5，作为一个拆分点，将该区间终止端的“2”行初值70减去5，作为一个拆分点）。最终将黄色的表格拆分成为蓝色的表格，蓝色表格中，黄色数字即为拆分点。
可能表述的有点复杂，不知道有没有高手能够指教一下啊（采用vba）！谢咯！

Answer 1

Sub next2(ByVal n, ByRef x1, ByRef x2) '获取下一个2的x1和x2的值
    Do While Cells(n, 1) <> ""
        n = n + 1
        If Cells(n, 1) = 2 Then
            x1 = Cells(n, 2)
            x2 = Cells(n, 3)
            Exit Sub
        End If
    Loop
    x1 = 0: x2 = 0
End Sub
Sub mysub() '主程序
    al = 1: fl = 6: n = 1: m = 1
    x01 = 0: x02 = 0
    Do While Cells(n, 1) <> ""
        k = Cells(n, al)
        If k = 2 Then
            x01 = x1: x02 = x2
            next2 n, x1, x2
        End If
        If x02 = 0 Or x1 - x02 <= 10 Or x1 = 0 Then '不用拆分
            Cells(m, fl) = Cells(n, al)
            Cells(m, fl + 1) = Cells(n, al + 1)
            Cells(m, fl + 2) = Cells(n, al + 2)
            m = m + 1
        Else
            k1 = x02 + 5: k2 = x1 - 5 '第一拆分点和第二拆分点
            xx1 = Cells(n, al + 1): xx2 = Cells(n, al + 2)
            If k1 > xx1 And k1 < xx2 Then '处理第一拆分点
                Cells(m, fl) = Cells(n, al)
                Cells(m, fl + 1) = xx1
                Cells(m, fl + 2) = k1
                m = m + 1
                xx1 = k1
            End If
            If k2 > xx1 And k2 < xx2 Then '处理第二拆分点
                Cells(m, fl) = Cells(n, al)
                Cells(m, fl + 1) = xx1
                Cells(m, fl + 2) = k2
                m = m + 1
                xx1 = k2
            End If
                Cells(m, fl) = Cells(n, al)
                Cells(m, fl + 1) = xx1
                Cells(m, fl + 2) = xx2
                m = m + 1
        End If
        n = n + 1
    Loop
End Sub