vba左右断面cass格式转苏交科断面格式

最新推荐文章于 2022-08-19 12:02:15 发布

花舞月咏潭

最新推荐文章于 2022-08-19 12:02:15 发布

阅读量156

点赞数

分类专栏： VBA

本文链接：https://blog.csdn.net/sinat_25006091/article/details/113823003

版权

VBA CASS 苏交科断面格式转换 Excel

关键词由CSDN通过智能技术生成

VBA 专栏收录该内容

27 篇文章 1 订阅

订阅专栏

'最后一行加一个BEGIN

Sub DM()
Dim i, j, m, n As Integer
For i = 1 To 1236

'左断面数据cass格式转苏交科断面格式
If Cells(i, 1) = "BEGIN" Then j = i
If Cells(i + 1, 1) = "0" Then m = i - j

For n = 1 To m - 1
If Cells(i + 1, 1) = "0" Then Cells(i, 1) = Abs(Cells(i, 1)): Cells(i, 2 * n + 1) = Abs(Cells(i - n, 1)): Cells(i, 2 * n + 2) = Abs(Cells(i - n, 2))
Next

Next
'右断面数据cass格式转苏交科断面格式

For i = 1 To 1236
If Cells(i, 1) = "0" Then j = i
If Cells(i + 1, 1) = "BEGIN" Then m = i - j
For n = 1 To m
If Cells(i + 1, 1) = "BEGIN" Then Cells(j, 2 * n + 1) = Cells(j + n, 1): Cells(j, 2 * n + 2) = Cells(j + n, 2)
Next

Next
'删除多余行
For k = 1236 To 1 Step -1
If Cells(k, 3) = "" Then Rows(k).Delete xlDown

Next
'里程
For k = 1 To 1236
If Cells(k, 1).Value = "BEGIN" Then Cells(k, 1) = Cells(k, 2): Cells(k, 2) = " ": Cells(k, 3) = ""

Next
End Sub