Option
Explicit
Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
Dim
lngFreieZeile
As
Long
Dim
lngLetzteZeile
As
Long
On
Error
GoTo
Fehler
With
ThisWorkbook.ActiveSheet
lngLetzteZeile = .Cells(.Cells.Rows.Count, 1).
End
(xlUp).Row
lngFreieZeile = lngLetzteZeile + 1
.Cells(lngFreieZeile,
"A"
) =
"Summe:"
.Cells(lngFreieZeile,
"B"
) = WorksheetFunction.Sum(Range(
"B1:B"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile,
"C"
) = WorksheetFunction.Sum(Range(
"C1:C"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile,
"D"
) = WorksheetFunction.Sum(Range(
"D1:D"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile,
"E"
) = WorksheetFunction.Sum(Range(
"E1:E"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 1,
"A"
) =
"Minimalwert:"
.Cells(lngFreieZeile + 1,
"B"
) = WorksheetFunction.Min(Range(
"B1:B"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 1,
"C"
) = WorksheetFunction.Min(Range(
"C1:C"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 1,
"D"
) = WorksheetFunction.Min(Range(
"D1:D"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 1,
"E"
) = WorksheetFunction.Min(Range(
"E1:E"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 2,
"A"
) =
"Maximalwert:"
.Cells(lngFreieZeile + 2,
"B"
) = WorksheetFunction.Max(Range(
"B1:B"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 2,
"C"
) = WorksheetFunction.Max(Range(
"C1:C"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 2,
"D"
) = WorksheetFunction.Max(Range(
"D1:D"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 2,
"E"
) = WorksheetFunction.Max(Range(
"E1:E"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 3,
"A"
) =
"Mittelwert:"
.Cells(lngFreieZeile + 3,
"B"
) = WorksheetFunction.Average(Range(
"B1:B"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 3,
"C"
) = WorksheetFunction.Average(Range(
"C1:C"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 3,
"D"
) = WorksheetFunction.Average(Range(
"D1:D"
&
CStr
(lngLetzteZeile)))
.Cells(lngFreieZeile + 3,
"E"
) = WorksheetFunction.Average(Range(
"E1:E"
&
CStr
(lngLetzteZeile)))
End
With
Exit
Sub
Fehler:
msgbox
"Ein Fehler ist aufgetreten!"
& Chr(10) &
"Fehlernummer: "
& Err.Number _
& Chr(10) &
"Fehlerbeschreibung: "
& Err.Description & Chr(10) _
&
"Verursacher: "
Err.Source & Chr(10) _
&
"Es sind möglicherweise nicht alle Werte korrekt berechnet!"
, vbExclamation,
"Fehler.."
Err.Clear
Resume
Next
End
Sub