ÁtlagHiba.txt

Sub ÁtlagHiba()
    If Selection.Areas.Count > 1 Then
        MsgBox "Cannot do this to a multiple selection."
        Exit Sub
    End If
    ' Get working area
    Dim src As Range
    Dim avg As Range
    Dim err As Range
    Dim res As Range
    Set src = Selection
    Dim srcs As String
    Dim w As Integer
    Dim h As Integer
    w = Selection.Columns.Count
    h = Selection.Rows.Count
    If w = 1 Then
        Set avg = src.Offset(0, 1)
        Set err = src.Offset(0, 2)
    ElseIf w = 2 Then
        Set src = src.Resize(ColumnSize:=1)
        w = 1
        Set avg = src.Cells(1, 1).Offset(h, 0)
        Set err = src.Cells(1, 2).Offset(h, 0)
    Else
        MsgBox "Width of selection must be 1 or 2."
        Exit Sub
    End If
    srcs = src.Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Set res = avg.Resize(ColumnSize:=2)
    If WorksheetFunction.CountA(res) <> 0 Then
        res.Select
        MsgBox "Destination is not empty!"
        Exit Sub
    End If
    ' Set average
    avg.Select
    Selection.Merge
    ActiveCell.Formula = "=AVERAGE(" & srcs & ")"
    With Selection
        .NumberFormat = "0.00"
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
    End With
    ' Set error
    err.Select
    Selection.Merge
    ActiveCell.Formula = "=STDEV(" & srcs & ")/SQRT(COUNTA(" & srcs & "))*TINV(0.05,COUNTA(" & srcs & ")-1)"
    With Selection
        .NumberFormat = "±0.00"
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With
    ' Set border
    res.Select
    Selection.Borders.LineStyle = xlContinuous
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
End Sub