路基分层和路基高程表格自动生成

gerogeedward

路基分层和路基高程表格使用、
Sub xl()


    Call train1
    ''''''''''实测高程等于设计高程加随机数-5,+5'''''
    Cells(9, 11) = "设计高程"
    Dim number1 As Integer
    number1 = 10
    Do While Trim(Cells(number1, 11)) <> ""

     Cells(number1, 15) = Application.WorksheetFunction.RandBetween(-5, 5) * 0.001
     Cells(number1, 6) = Application.WorksheetFunction.Round(Cells(number1, 15) + Cells(number1, 11), 3)
     number1 = number1 + 1

     Loop
     '''''''''''''''''''实测高程等于设计高程加随机数-5,+5'''''

    Dim a As Integer, b As Integer, c As Integer, d As Integer
    x = 0
    a = 9
    e = 9
    d = 0
    f = 9
    Cells(a, 4) = Application.WorksheetFunction.RandBetween(1200, 3000)
    Cells(a, 5) = Cells(9, 7) + Cells(a, 4) * 0.001
99:
    a = a + b
    f = b + f
89:
    b = 1



    Do While Trim(Cells(a + b, 10)) <> ""
        c = Cells(a, 5)
        Cells(a + b, 3) = Cells(a, 5) - Cells(a + b, 6)
        Cells(a + b, 3) = Cells(a + b, 3) * 1000
        e = e + 1
        ''''''''每隔150米转点'''''''''''
        If Cells(f + b, 16) - Cells(f + 1, 16) > 150 Then
            Rows(a + b & ":" & a + b).Select
            Selection.Insert Shift:=xlShiftDown
            Rem 加入一行
            Cells(a + b, 2) = Application.WorksheetFunction.RandBetween(1100, 1800)
            Cells(a + b, 4) = Application.WorksheetFunction.RandBetween(1100, 1800)
            Cells(a + b, 5) = Cells(a, 5) + Cells(a + b, 4) * 0.001 - Cells(a + b, 2) * 0.001
            x = x + 1
            Cells(a + b, 1) = "ZD" & x
            GoTo 99
        End If
        ''''''''每隔140米转点'''''''''''
        If Cells(a + b, 3) < 300 Then

            Rows(a + b & ":" & a + b).Select
            Selection.Insert Shift:=xlShiftDown
            Rem 加入一行
            Cells(a + b, 2) = Application.WorksheetFunction.RandBetween(300, 1100)
            Cells(a + b, 4) = Application.WorksheetFunction.RandBetween(3900, 4700)
            Cells(a + b, 5) = Cells(a, 5) + Cells(a + b, 4) * 0.001 - Cells(a + b, 2) * 0.001
            x = x + 1
            Cells(a + b, 1) = "ZD" & x
            GoTo 99
        Else
            If Cells(a + b, 3) > 4700 Then
                Rows(a + b & ":" & a + b).Select
                Selection.Insert Shift:=xlShiftDown
                Rem 加入一行
                Cells(a + b, 2) = Application.WorksheetFunction.RandBetween(3900, 4700)
                Cells(a + b, 4) = Application.WorksheetFunction.RandBetween(300, 1100)
                Cells(a + b, 5) = Cells(a, 5) + Cells(a + b, 4) * 0.001 - Cells(a + b, 2) * 0.001
                x = x + 1
                Cells(a + b, 1) = "ZD" & x
                GoTo 99
            End If

        End If
        b = b + 1
    Loop

991:

    Cells(a + b, 2) = Cells(a, 5) - Cells(a + b, 6)
    Cells(a + b, 2) = Cells(a + b, 2) * 1000
    'MsgBox "finish"

    Do While Trim(Cells(a + b, 2)) < 300 Or Trim(Cells(a + b, 2)) > 4700
        If Cells(a + b, 2) < 300 Then

            Rows(a + b & ":" & a + b).Select
            Selection.Insert Shift:=xlShiftDown
            Rem 加入一行
            Cells(a + b, 2) = Application.WorksheetFunction.RandBetween(300, 1100)
            Cells(a + b, 4) = Application.WorksheetFunction.RandBetween(3900, 4700)
            Cells(a + b, 5) = Cells(a, 5) + Cells(a + b, 4) * 0.001 - Cells(a + b, 2) * 0.001
            x = x + 1
            Cells(a + b, 1) = "ZD" & x
            GoTo 990
        Else
            If Cells(a + b, 2) > 4700 Then
                Rows(a + b & ":" & a + b).Select
                Selection.Insert Shift:=xlShiftDown
                Rem 加入一行
                Cells(a + b, 2) = Application.WorksheetFunction.RandBetween(3900, 4700)
                Cells(a + b, 4) = Application.WorksheetFunction.RandBetween(300, 1100)
                Cells(a + b, 5) = Cells(a, 5) + Cells(a + b, 4) * 0.001 - Cells(a + b, 2) * 0.001
                x = x + 1
                Cells(a + b, 1) = "ZD" & x
                GoTo 99
            End If

        End If
        b = b + 1
    Loop
    GoTo 9999
990:
    a = a + b
    b = 1
    GoTo 991
9999:
    MsgBox "99"


    'Call quchuhuanse1
End Sub