Option
Explicit
Sub
Einfach()
Dim
rngMittelZelle
As
Range
Dim
rngMonatswertZelle
As
Range
Dim
rngMittelBereich
As
Range
With
ActiveSheet
Set
rngMonatswertZelle = Selection
Select
Case
rngMonatswertZelle.Column
Case
Is
>= 4
Set
rngMittelBereich = _
Range(rngMonatswertZelle.Offset(, -2), rngMonatswertZelle)
Case
3
Set
rngMittelBereich = _
Range(rngMonatswertZelle.Offset(, -1), rngMonatswertZelle)
Case
2
Set
rngMittelBereich = rngMonatswertZelle
End
Select
Set
rngMittelZelle = .Range(
"N3"
)
rngMittelZelle.ClearContents
On
Error
Resume
Next
rngMittelZelle.Value = WorksheetFunction.Average(rngMittelBereich)
On
Error
GoTo
0
End
With
End
Sub
Sub
Mittelwert()
Dim
rngMittelZelle
As
Range
Dim
rngMonatswertZelle
As
Range
Dim
rngMittelBereich
As
Range
Dim
Flag
As
Boolean
With
ActiveSheet
Set
rngMittelZelle = .Cells(1, .Columns.Count).
End
(xlToLeft)
Set
rngMittelZelle = rngMittelZelle.Offset(2)
With
.Rows(2)
Set
rngMonatswertZelle = .Find(What:=Month(
Date
), After:=.Cells(1), _
LookIn:=xlValues, LookAt:=xlWhole)
End
With
Set
rngMonatswertZelle = rngMonatswertZelle.Offset(1)
If
rngMonatswertZelle.Value <> 0
Then
Select
Case
rngMonatswertZelle.Column
Case
Is
>= 4
Set
rngMittelBereich = _
Range(rngMonatswertZelle.Offset(, -2), rngMonatswertZelle)
Case
3
Set
rngMittelBereich = _
Range(rngMonatswertZelle.Offset(, -1), rngMonatswertZelle)
Flag =
True
Case
2
Set
rngMittelBereich = rngMonatswertZelle
Flag =
True
End
Select
Else
Select
Case
MsgBox(
"kein aktueller Wert für Monat "
& Month(
Date
) _
& Chr(10) &
"dennoch rechnen?"
, _
vbYesNo + vbExclamation,
"Achtung"
)
Case
vbYes
Select
Case
rngMonatswertZelle.Column
Case
Is
>= 4
Set
rngMittelBereich = _
Range(rngMonatswertZelle.Offset(, -2), rngMonatswertZelle)
Case
3
Set
rngMittelBereich = _
Range(rngMonatswertZelle.Offset(, -1), rngMonatswertZelle)
Flag =
True
Case
2
Set
rngMittelBereich = rngMonatswertZelle
Flag =
True
End
Select
Case
vbNo
Do
Set
rngMonatswertZelle = rngMonatswertZelle.Offset(, -1)
If
IsNumeric(rngMonatswertZelle.Value)
Then
Flag =
True
Exit
Do
Else
Exit
Sub
End
If
Loop
Select
Case
rngMonatswertZelle.Column
Case
Is
>= 4
Set
rngMittelBereich = _
Range(rngMonatswertZelle.Offset(, -2), rngMonatswertZelle)
Case
3
Set
rngMittelBereich = _
Range(rngMonatswertZelle.Offset(, -1), rngMonatswertZelle)
Flag =
True
Case
2
Set
rngMittelBereich = rngMonatswertZelle
Flag =
True
End
Select
End
Select
End
If
rngMittelZelle.ClearContents
On
Error
Resume
Next
rngMittelZelle.Value = WorksheetFunction.Average(rngMittelBereich)
On
Error
GoTo
0
End
With
If
Flag =
True
Then
_
Call
MsgBox(
"kein Mittelwert aus 3 Monaten! "
, _
vbOKOnly + vbExclamation,
"Achtung"
)
End
Sub