excel-vba组内离均差

来源：互联网发布：网页编程用什么语言编辑：程序博客网时间：2024/06/10 07:47

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

0 0