Excel表格制作标高计算程序
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
Excel表格制作标高计算程序
新建一个Excel文件，把Sheet1表重命名为“竖曲线”，把Sheet2表重命名为“设计标高”。
（1）在竖曲线表中的A1-E1（合并）单元格输入线路名称，在A2-E2单元格中分别输入“变坡点编号”、“变坡点里程”、“变坡点标高”、“曲线半径”和“切线长”,从第三行开始输入对应数据，
（2）打开VB编辑器（Alt+F11），双击工程资源管理器中“设计标高”表图标，复制以下程序到界面上，保存后返回Excel窗口，在“设计标高”表中的第一列，从第二行开始输入要计算的里程桩号，完成后，在任一单元格中双击单元格，即可看见输入结果（在第二列），本程序默认遇到桩号列空单元格时不再向下计算。
Dim K As Double
Dim H As Double
Dim P1 As Double, P2 As Double, P3 As Double
Dim H1 As Double, H2 As Double
Dim R1 As Double, R2 As Double
Dim T1 As Double, T2 As Double
Dim D1 As Double, D2 As Double
Dim G1 As Long, G2 As Long
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) On Error Resume Next
Dim i As Long
Dim hang As Long
Dim cell
n = 0
For Each cell In Sheets("竖曲线").Range("a3:a65536")
If cell.Value <> "" Then
n = n + 1
Else
Exit For
End If
Next
i = 2
flag:
P2 = 0
P3 = 0
hang = 3
If Sheets("设计标高").Cells(i, 1) <> "" Then
K = Val(Cells(i, 1))
canshu:
P1 = P2
D1 = Val(Sheets("竖曲线").Cells(hang + 1, 2))
D2 = Val(Sheets("竖曲线").Cells(hang + 2, 2))
H1 = Val(Sheets("竖曲线").Cells(hang + 1, 3))
H2 = Val(Sheets("竖曲线").Cells(hang + 2, 3))
P3 = (H2 - H1) / (D2 - D1)
D1 = Val(Sheets("竖曲线").Cells(hang, 2))
D2 = Val(Sheets("竖曲线").Cells(hang + 1, 2))
H1 = Val(Sheets("竖曲线").Cells(hang, 3))
H2 = Val(Sheets("竖曲线").Cells(hang + 1, 3))
R1 = Val(Sheets("竖曲线").Cells(hang, 4))
R2 = Val(Sheets("竖曲线").Cells(hang + 1, 4))
T1 = Val(Sheets("竖曲线").Cells(hang, 5))
T2 = Val(Sheets("竖曲线").Cells(hang + 1, 5))
P2 = (H2 - H1) / (D2 - D1)
If K < D1 Then Sheets("设计标高").Cells(i, 3) = "超出": i = i + 1: GoTo flag If K > D2 And hang < n + 3 Then
hang = hang + 1
GoTo canshu
Else
Call biaogao
Sheets("设计标高").Cells(i, 2) = Round(H, 3)
End If
Else
End
End If
i = i + 1
GoTo flag
End Sub
Function biaogao() As Double
On Error Resume Next
G1 = -1
If P2 - P1 > 0 Then G1 = 1
G2 = -1
If P3 - P2 > 0 Then G2 = 1
H = 0
If K < D1 + T1 Then
H = H1 + (K - D1) * P2 + G1 * (D1 + T1 - K) ^ 2 / (2 * R1)
ElseIf K <= D2 - T2 Then
H = H1 + (K - D1) * P2
Else
If R2 <> 0 Then
H = H2 - (D2 - K) * P2 + G2 * (K - (D2 - T2)) ^ 2 / (2 * R2)
Else
H = H2 - (D2 - K) * P2
End If
End If
End Function
本程序只计算单一线路的中桩标高，若想把多个线路的参数放在同一个表中时，只需对以上程序稍加改动即可。