Thema Datum  Von Nutzer Rating
Antwort
05.04.2011 11:22:34 Chris
NotSolved
05.04.2011 11:49:17 Severus
NotSolved
05.04.2011 14:38:04 Gast24401
NotSolved
05.04.2011 15:01:17 Severus
NotSolved
05.04.2011 15:37:04 Gast92077
NotSolved
05.04.2011 16:13:50 Severus
NotSolved
08.04.2011 11:39:32 Gast82742
NotSolved
08.04.2011 14:04:12 Gast97480
NotSolved
05.04.2011 14:00:24 Gast20655
Solved
Blau Einfügen einer Summe an das Ende einer flexiblen Tabelle
08.04.2011 16:27:25 Severus
NotSolved

Ansicht des Beitrags:
Von:
Severus
Datum:
08.04.2011 16:27:25
Views:
1502
Rating: Antwort:
  Ja
Thema:
Einfügen einer Summe an das Ende einer flexiblen Tabelle

Mach einfach eine Ereignisprozedur draus: Schreib die Prozedur in das Klassenmodul des Arbeitsblattes, in dem die Tabelle steht, also z.B. "Tabelle1(Tabelle1)" und benenne sie in "Private Sub Worksheet_Change(ByVal Target As Range)" um:

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

Dann wird der Wert bei jeder Änderung neu berechnet.


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.04.2011 11:22:34 Chris
NotSolved
05.04.2011 11:49:17 Severus
NotSolved
05.04.2011 14:38:04 Gast24401
NotSolved
05.04.2011 15:01:17 Severus
NotSolved
05.04.2011 15:37:04 Gast92077
NotSolved
05.04.2011 16:13:50 Severus
NotSolved
08.04.2011 11:39:32 Gast82742
NotSolved
08.04.2011 14:04:12 Gast97480
NotSolved
05.04.2011 14:00:24 Gast20655
Solved
Blau Einfügen einer Summe an das Ende einer flexiblen Tabelle
08.04.2011 16:27:25 Severus
NotSolved