测量高程资料的高程表格函数内容

gerogeedward

Sub xl()
Dim a As Integer, b As Integer, c As Integer, d As Integer
a = 9
e = 9
d = 0
Cells(a, 5) = Cells(9, 7) + Cells(a, 4) * 0.001
99:
      a = a + b

89:
b = 1

Do While Trim(Cells(a + b, 10)) <> "ok"
         c = Cells(a, 5)
     Cells(a + b, 3) = Cells(a, 5) - Cells(a + b, 7)
     Cells(a + b, 3) = Cells(a + b, 3) * 1000
         e = e + 1
          If Cells(a + b, 3) < 300 Then

            Rows(a + b & ":" & a + b).Select
             Selection.Insert Shift:=xlShiftDown
                Rem 加入一行
                 Cells(a + b, 2) = 300
                 Cells(a + b, 4) = 4500
                 Cells(a + b, 5) = Cells(a, 5) + Cells(a + b, 4) * 0.001 - Cells(a + b, 2) * 0.001

                  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) = 4500
                 Cells(a + b, 4) = 500
                 Cells(a + b, 5) = Cells(a, 5) + Cells(a + b, 4) * 0.001 - Cells(a + b, 2) * 0.001

                  GoTo 99
              End If

        End If
      b = b + 1




Loop


         Cells(a + b, 2) = Cells(a, 5) - Cells(a + b, 6)
                     Cells(a + b, 2) = Cells(a + b, 2) * 1000

     MsgBox "finish"
End Sub

gerogeedward

Worksheets(“Sheet1”).Range(Cells(5, 2), Cells(5, 2)) = Application.WorksheetFunction.Average(Worksheets("Sheet1").Range(Cells(1, 2), Cells(4, 2)))
上式为，在“Sheet1”中在"B5"单元格中计算“B1：B4”的均值的结果！

gerogeedward

Sub xl()
Dim a As Integer, b As Integer, c As Integer, d As Integer
a = 9
e = 9
d = 0
Cells(a, 4) = Application.WorksheetFunction.RandBetween(1000, 4000)
Cells(a, 5) = Cells(9, 7) + Cells(a, 4) * 0.001
99:
      a = a + b

89:
b = 1

Do While Trim(Cells(a + b, 10)) <> "ok"
         c = Cells(a, 5)
     Cells(a + b, 3) = Cells(a, 5) - Cells(a + b, 7)
     Cells(a + b, 3) = Cells(a + b, 3) * 1000
         e = e + 1
          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, 1000)
                 Cells(a + b, 4) = Application.WorksheetFunction.RandBetween(4000, 4700)
                 Cells(a + b, 5) = Cells(a, 5) + Cells(a + b, 4) * 0.001 - Cells(a + b, 2) * 0.001
               
                  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(4000, 4700)
                 Cells(a + b, 4) = Application.WorksheetFunction.RandBetween(300, 1000)
                 Cells(a + b, 5) = Cells(a, 5) + Cells(a + b, 4) * 0.001 - Cells(a + b, 2) * 0.001
               
                  GoTo 99
              End If
              
        End If
      b = b + 1
           
         
      
      
Loop

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

调整了下大小随机数

yanghua51302

好东西，学习学习，谢谢

yanghua51302

好东西，学习学习，谢谢