本文主要是介绍VBA处理DINI03水准路线（bf）+中间点，希望对大家解决编程问题提供一定的参考价值，需要的开发者们随着小编来一起学习吧！
Sub 计算中间点()
Dim A As Double
Dim i, R As Integer
Dim H As String
Range("g1:g100").Offset(0, 1).Insert
Range("h1:h100").Offset(0, 1).Insert
Range("i1:i100").Offset(0, 1).Insert
For i = 1 To 100
If Cells(i, 13) = "Rb" And Cells(i + 1, 13) = "Rf" Then
A = Cells(i, 14)
R = Cells(i, 17)
H = Cells(i, 7)
Cells(i + 1, 8) = Cells(i + 1, 7)
Cells(i + 1, 7) = H
Cells(i + 1, 9) = Round(Cells(i, 14) - Cells(i + 1, 14), 7)
Cells(i + 1, 10) = Round((Cells(i, 17) + Cells(i + 1, 17)) / 1000, 3)
Cells(i + 1, 7) = Cells(i, 7)
ElseIf Cells(i, 13) = "Rz" Then
Cells(i, 8) = Cells(i, 7)
Cells(i, 7) = H
Cells(i, 9) = Round(A - Cells(i, 14), 7)
Cells(i, 10) = Round((R + Cells(i, 17)) / 1000, 3)
ElseIf Cells(i, 6) = "End" Or Cells(i, 6) = "Intermediate" Then Cells(i, 9) = ""
Cells(i, 10) = ""
End If
Next
End Sub
Sub 生成IN1()
Sheet2.Range("a1:d86").Value = Sheet1.Range("G1:J86").Value
Sheet2.Range("e1:e86").Value = "1"
End Sub
Sub 输出IN1()
Dim j As Long
For j = Sheet2.Cells(1048576, 2).End(xlUp).Row To 1 Step -1
If Sheet2.Cells(j, 2) = "" Then '如果单元格为空白
Sheet2.Cells(j, 2).EntireRow.Delete '符合条件的都删除整行
End If
Next '检测下一个
Dim s As String
Dim FullName As String, rng As Range
Application.ScreenUpdating = False
FullName = (ActiveSheet.Name & ".IN1") '以当前表名为TXT文件名
' FullName = Replace(ThisWorkbook.FullName, ".xls", ".txt") '以当前文件名为TXT文件名
' FullName = Replace(ThisWorkbook.FullName, ".xls", ActiveSheet.Name & ".txt") '以文件名&表名为TXT文件名
Open FullName For Output As #1 '以读写方式打开文件，每次写内容都会覆盖原先的内容
'参考帮助，fullname为文件全名
For Each rng In Sheet2.Range("a1").CurrentRegion
s = s & IIf(s = "", "", ",") & rng.Value
If rng.Column = Sheet2.Range("a1").CurrentRegion.Columns.Count Then
Print #1, s & " " '把数据写到文本文件里
s = ""
' Else
'
' Print #1, s & "" '把数据写到文本文件里
'
' s = ""
End If
Next
Close #1 '关闭文件
Application.ScreenUpdating = True
MsgBox "数据已导入文本"
End Sub
这篇关于VBA处理DINI03水准路线（bf）+中间点的文章就介绍到这儿，希望我们推荐的文章对编程师们有所帮助！
