Hallo Mick,
erstelle eine Beispieldatei:
A1 bis A13 mit Datum
B1 bis B13 mit Beträgen
Den Hintergrund der Zelle D1, färbst du mit der gleichen Hintergundfarbe Rot,
wie die Roten Zellen in den Beträgen B1 bis B13
Den Hintergrund der Zelle E1, färbst du mit der gleichen Hintergundfarbe Gelb,
wie die Roten Zellen in den Beträgen B1 bis B13
Den Hintergrund der Zelle F1, färbst du mit der gleichen Hintergundfarbe Grün,
wie die Roten Zellen in den Beträgen B1 bis B13
Den Hintergrund der Zelle G1, färbst du mit der gleichen Hintergundfarbe Braun,
wie die Roten Zellen in den Beträgen B1 bis B13
Den Hintergrund der Zelle H1, färbst du z.B. nicht,
dann wird in dieser Zelle alles ohne Hintergrundfarbe, der Zellen B1 bis B13 summiert.
Jetzt ein Rechts- Klick, Unten auf den Blattreiter der Tabelle, z.B. der Tabelle1
Code anzeigen wählen
Jetzt kopierst du den Code, nach
Hier der geänderte Code:
in das freie Rechte Makrofenster.
Den Makroeditor wieder schließen und wieder in die Tabelle mit den Summen wechseln.
Das geänderte Makro startet, wenn du in den Bereich der Zellen D1 bis H1 klickst.
Färbst du eine Zelle um, dann klicke anschließend wieder in den Bereich der Zellen D1 bis H1 und die Summen werden neu berechnet.
Da du keine Excelversion nicht angegeben hast, hoffe ich dass der Code bei dir läuft.
Wenn nicht, nochmals melden und deine Excelversion angeben.
Der Grün angezeigte Text im Makroeditor, nach dem kopieren, ist Bemerkung und wird vom Makro nicht beachtet.
Hier der geänderte Code:
'Datum in A1 bis A13
'Betrag in B1 bis B13
'Den Hintergrund der Betrag Zellen färben
'
'Summen Zellen im Beispiel, D1, E1, F1, G1 und H1(diese Zelle ohne Hintergrundfarbe, oder eine weitere Hintergrundfarbe)
'Den Hintergrund, der Ergebnis- Zellen, mit den gewünschten Farben färben
'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
Dim Summe1 As Double, Summe2 As Double, Summe3 As Double, Summe4 As Double, Summe5 As Double
Dim Farbe1 As Integer, Farbe2 As Integer, Farbe3 As Integer, Farbe4 As Integer, Farbe5 As Integer
If Intersect(Target, Range("D1:H5")) Is Nothing Then Exit Sub
'Farbe1 bis Farbe5, die Zellhindergrundfarben der Zellen D1 bis H1 zuweisen.
Farbe1 = Cells(1, "D").Interior.ColorIndex
Farbe2 = Cells(1, "E").Interior.ColorIndex
Farbe3 = Cells(1, "F").Interior.ColorIndex
Farbe4 = Cells(1, "G").Interior.ColorIndex
Farbe5 = Cells(1, "H").Interior.ColorIndex
'Makrolauf, von der Zeile 1, bis zur letzten belegten Zeile
For i = 1 To ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
'Summieren, wenn der Wert der Zelle eine Zahl ist.
If IsNumeric(Cells(i, 2)) Then
If Cells(i, 2).Interior.ColorIndex = Farbe1 Then Summe1 = Summe1 + Cells(i, 2)
If Cells(i, 2).Interior.ColorIndex = Farbe2 Then Summe2 = Summe2 + Cells(i, 2)
If Cells(i, 2).Interior.ColorIndex = Farbe3 Then Summe3 = Summe3 + Cells(i, 2)
If Cells(i, 2).Interior.ColorIndex = Farbe4 Then Summe4 = Summe4 + Cells(i, 2)
If Cells(i, 2).Interior.ColorIndex = Farbe5 Then Summe5 = Summe5 + Cells(i, 2)
End If
Next
'Die Summen in die Zellen D1 bis H1 schreiben.
Cells(1, "D") = Summe1
Cells(1, "E") = Summe2
Cells(1, "F") = Summe3
Cells(1, "G") = Summe4
Cells(1, "H") = Summe5
End Sub
NACHTRAG: Hast du eine Excelversion, größer Excel 2002,
dann speicher die Datei statt mit der Datei- Endung .xlsx,
mit der Datei- Endung .xlsm ab,
sonst wird der Makrocode nicht gespeichert,
denn die Datei- Endung .xlsx, ist nur für Dateien ohne Makros vorgesehen.
Dann viel Spass beim testen.
hddiesel
