vba 光学四等水准

Sub 站数递增()
Dim i As Integer
Dim j As Integer
Dim Z As Integer
Dim X As Integer

For i = 9 To 24 Step 4
Z = Cells(i, 18)
For X = 9 To 62 Step 4
If (Cells(X, 1).Row - 5) / 4 <= Z Then Cells(X, 1) = (X - 5) / 4
 Next X
 Next i
End Sub

Sub 段1红黑尺()
Dim i As Integer
Dim j As Integer
Dim Z As Integer
Dim X As Integer
Dim M As Integer
Dim N As Integer
Dim C As Integer
Dim G As Double
 
 Z = Cells(9, 19)          '黑尺读数
 G = Cells(9, 20)
 For i = 9 To (Z * 4 + 1) Step 4
 Cells(i, 12) = Rnd() * 0.4 - 0.2                '中间点高差
 Cells(i + 2, 9) = Cells(i, 12) + Rnd() * 0.006 - 0.003  '后-前
 Cells(i, 9) = Rnd() * 1000 + 400              '中丝后黑尺读数

  Cells(i + 1, 9) = Cells(i, 9) - Cells(i + 2, 9) * 1000 '中丝前黑尺读数

 
 Cells(i, 3) = Round(Cells(i, 9) + 300 + Rnd() * 100)  '后尺上丝读数
 Cells(i + 1, 3) = Round(Cells(i, 9) - 300 + Rnd() * 100) '后尺下丝读数
 Cells(i + 2, 3) = (Cells(i, 3) - Cells(i + 1, 3)) / 10   '后尺距离
  Cells(i, 5) = Int(Cells(i, 3) - Cells(i + 2, 9) * 1000)         '前尺上丝读数
Cells(i + 1, 5) = Int(Cells(i + 1, 3) - Cells(i + 2, 9) * 1000 + Rnd() * 10 - 5) '前尺下丝读数
Cells(i + 2, 5) = (Cells(i, 5) - Cells(i + 1, 5)) / 10         '前尺距离
Cells(i + 3, 3) = Cells(i + 2, 3) - Cells(i + 2, 5)          '视距差=后-前

 If Cells(i, 1) Mod 2 = 1 Then
 Cells(i, 10) = Cells(i, 9) + 4787: Cells(i + 1, 10) = Cells(i + 1, 9) + 4687:  Cells(i + 2, 10) = (Cells(i, 10) - Cells(i + 1, 10)) / 1000
 Else:
 Cells(i, 10) = Cells(i, 9) + 4687: Cells(i + 1, 10) = Cells(i + 1, 9) + 4787:  Cells(i + 2, 10) = (Cells(i, 10) - Cells(i + 1, 10)) / 1000
   End If

 Next i

Cells(i, 12) = G - (Cells(i - 4, 12) + Cells(i - 8, 12) + Cells(i - 12, 12))
Cells(i + 2, 9) = Cells(i, 12) + Rnd() * 0.006 - 0.003
Cells(i, 9) = Rnd() * 1600 + 200
Cells(i + 1, 9) = Cells(i, 9) - Cells(i + 2, 9) * 1000

 If i = 9 Then                                                 '计算累积差
Cells(i + 3, 5) = Cells(i + 3, 3)
Else
Cells(i + 3, 5) = Cells(i - 1, 5) + Cells(i + 3, 3)

  End If
 
End Sub