excel-vba组内离均差

Sub 组内离均差()

'

' 组内平均值 Macro

' 宏由 zzh_my@163.com 录制，时间: 2015/11/18

'

'点名    初始化时间(s)   测量时刻    次序号  平面x(m)    平面y(m)    大地高(m)   解类型  备注    观测类型    观测者  x组内离均值 y组内离均值 H组内离均值 abs(x组内离均值)    abs(y组内离均值)    abs(H组内离均值)        x   x百分比 y   y百分比 H   H百分比

      '需按照点名先排列好

            n = 0

            x = 0

            y = 0

            H = 0

            sheetname = "1-投影129xyH"

           ' rowNumber = 933  'x = range("A65536").end(xlup).row  i = cells(rows.count,1).end(xlup).row+1

            rowNumber = Worksheets(sheetname).Cells(Rows.Count, 1).End(xlUp).Row

      For i = 2 To rowNumber Step 1

            

           ' MsgBox (Name)

           '假如点名和下一条相等，且观测类型相等

           If (Worksheets(sheetname).Cells(i, 1).Value = Worksheets(sheetname).Cells(i + 1, 1)) And (Worksheets(sheetname).Cells(i, 10).Value = Worksheets(sheetname).Cells(i + 1, 10)) Then

               n = n + 1

               

                x = x + Worksheets(sheetname).Cells(i, 5).Value

                y = y + Worksheets(sheetname).Cells(i, 6).Value

                H = H + Worksheets(sheetname).Cells(i, 7).Value

           Else

                For j = 1 To n + 1 Step 1

                    x_mean = x / n

                    y_mean = y / n

                    H_mean = H / n

                    h1 = Worksheets(sheetname).Cells(i - j + 1, 7).Value

                   ' MsgBox (x_mean)

                    Worksheets(sheetname).Cells(i - j + 1, 12).Value = Worksheets(sheetname).Cells(i - j + 1, 5).Value - x_mean

                    Worksheets(sheetname).Cells(i - j + 1, 13).Value = Worksheets(sheetname).Cells(i - j + 1, 6).Value - y_mean

                    Worksheets(sheetname).Cells(i - j + 1, 14).Value = Worksheets(sheetname).Cells(i - j + 1, 7).Value - H_mean

                 Next j

                    x = 0

                    y = 0

                    H = 0

                    x_mean = 0

                    y_mean = 0

                    H_mean = 0

                    n = 0

                    

           End If

     

     Next i

    

End Sub