Zellen mit Doppelklick einfärben

Question

Hallo,

ich arbeite mit Excel 2010 und möchte nun per Doppelklick zellen einfärben.

Nur möchte ich, dass in Spalte G per Doppelklick die Farbe GRÜN, in Spalte H die Farbe GELB und in Spalte I die Farbe ROT anzeigt. Mache ich wieder einen Doppelklick drauf, soll die Farbe gelöscht und KEINE Füllung mehr sein.

Zum Schluss wäre es super, wenn in Zeile 105, Spalte G die Summe aller Grünen, in Spalte H aller Gelben und in Spalte I alle Roten gezählt werden.

Wäre super, wenn mir hier geholfen werden kann.

Danke

Gruß Florian

Answer 1

Hallo,

das Einfärben geht aus meiner Sicht nur per Makro und da mit der Funktion

Worksheet_Change(ByVal Target As Range)

Gruß

Helmut

Answer 2

Hallo Florian,

Helmut stimme ich zu es ist nur die falsche Aktion.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Gruß Hajo

Answer 3

Hallo Hajo, Hallo Helmut,

ich hab mit "meinem Wissen" ein wenig herumgebastelt und hab das hier zusammen gestellt. So funktioniert das farbig machen zumindest schon mal in Spalte G. Allerdings nicht in H und J. Das zusammenzählen hab ich jetzt mal umständlich mit einer Formel (Zeile zuordnen) gemacht. ( Namenseditor - Farbe - =ZELLE.ZUORDNEN(63;INDIREKT("ZS(-1)";FALSCH)) )

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
'Falls aktive Zelle nicht in Spalten L oder M liegt, Makro beenden
If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub

With ActiveCell
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
Cancel = True
End With
End With

If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub

With ActiveCell
With Selection.Interior
.ColorIndex = 5
.Pattern = xlSolid
Cancel = True
End With
End With


If Intersect(Target, Range("I:I")) Is Nothing Then Exit Sub

With ActiveCell
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
Cancel = True
End With
End With

End Sub

Wie muss die Formel aussehen, damit sie funktioniert und WARUM funktioniert sie nicht?

Gruß Florian

Answer 4

Hallo Florian!

Nachfolgend mal eine Lösung, die Dir das gewünschte Ergebnis liefern sollte.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngZelle As Range
Dim dblSumme As Double

Select Case Target.Column

Case 7 'Spalte G
If Target.Cells.Interior.ColorIndex = 4 Then
'Farbe aufheben
Target.Cells.Interior.ColorIndex = 0
Else
'Farbe zuweisen
Target.Cells.Interior.ColorIndex = 4
End If
'Zellen mit Hintergrundfarbe zählen
For Each rngZelle In Range("G1:G104")
If rngZelle.Interior.ColorIndex = 4 Then
dblSumme = dblSumme + rngZelle
End If
Next
Range("G105") = dblSumme

Case 8 'Spalte H
If Target.Cells.Interior.ColorIndex = 5 Then
'Farbe aufheben
Target.Cells.Interior.ColorIndex = 0
Else
'Farbe zuweisen
Target.Cells.Interior.ColorIndex = 5
End If
'Zellen mit Hintergrundfarbe zählen
For Each rngZelle In Range("H1:H104")
If rngZelle.Interior.ColorIndex = 5 Then
dblSumme = dblSumme + rngZelle
End If
Next
Range("H105") = dblSumme

Case 9 'Spalte I
If Target.Cells.Interior.ColorIndex = 6 Then
'Farbe aufheben
Target.Cells.Interior.ColorIndex = 0
Else
'Farbe zuweisen
Target.Cells.Interior.ColorIndex = 6
End If
'Zellen mit Hintergrundfarbe zählen
For Each rngZelle In Range("I1:I104")
If rngZelle.Interior.ColorIndex = 6 Then
dblSumme = dblSumme + rngZelle
End If
Next
Range("I105") = dblSumme
End Select
End Sub

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 5

Hallo Oliver,

vielen Dank für deine schnelle Unterstützung.

ich habe deinen Code in meine Datei kopiert und angewendet.

Soweit so gut. Nur bei "dblSumme = dblSumme + rngZelle" geht's nicht weiter. Da bringt Excel" Laufzeitfehler '13' Typen unverträglich

Gruß
Florian

Answer 6

Hallo Florian!

Was für Werte stehen in den Zellen, deren Summe addiert werden sollen?

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 7

Hallo Florian!
Ich gehe davon aus, dass in den Zeilen 1 bis 104 in der jeweiligen Spalte nicht nur Zahlen, sondern auch texte stehen, daher der Fehler. nachfolgend der VBA-Code abgeändert.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngZelle As Range
Dim dblSumme As Double

Select Case Target.Column

Case 7 'Spalte G
If Target.Cells.Interior.ColorIndex = 4 Then
'Farbe aufheben
Target.Cells.Interior.ColorIndex = 0
Else
'Farbe zuweisen
Target.Cells.Interior.ColorIndex = 4
End If
'Zellen mit Hintergrundfarbe zählen
For Each rngZelle In Range("G1:G104")
If rngZelle.Interior.ColorIndex = 4 Then
On Error Resume Next
dblSumme = dblSumme + rngZelle
On Error GoTo 0
End If
Next
Range("G105") = dblSumme

Case 8 'Spalte H
If Target.Cells.Interior.ColorIndex = 5 Then
'Farbe aufheben
Target.Cells.Interior.ColorIndex = 0
Else
'Farbe zuweisen
Target.Cells.Interior.ColorIndex = 5
End If
'Zellen mit Hintergrundfarbe zählen
For Each rngZelle In Range("H1:H104")
If rngZelle.Interior.ColorIndex = 5 Then
On Error Resume Next
dblSumme = dblSumme + rngZelle
On Error GoTo 0
End If
Next
Range("H105") = dblSumme

Case 9 'Spalte I
If Target.Cells.Interior.ColorIndex = 6 Then
'Farbe aufheben
Target.Cells.Interior.ColorIndex = 0
Else
'Farbe zuweisen
Target.Cells.Interior.ColorIndex = 6
End If
'Zellen mit Hintergrundfarbe zählen
For Each rngZelle In Range("I1:I104")
If rngZelle.Interior.ColorIndex = 6 Then
On Error Resume Next
dblSumme = dblSumme + rngZelle
On Error GoTo 0
End If
Next
Range("I105") = dblSumme
End Select
End Sub

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 8

Hallo Florian,

hatte fast dieselbe Idee wie Oliver

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngc As Range, dblZ As Double
On Error Resume Next
Select Case Target.Column
Case 7
If Target.Interior.Color = 5287936 Then
Target.Interior.Pattern = xlNone
Else
Target.Interior.Color = 5287936
End If
For Each rngc In Range("G1:G104")
If rngc.Interior.Color = 5287936 Then
dblZ = dblZ + rngc
End If
Next
Range("G105").Value = dblZ
Case 8
If Target.Interior.Color = 65535 Then
Target.Interior.Pattern = xlNone
Else
Target.Interior.Color = 65535
End If
For Each rngc In Range("H1:H104")
If rngc.Interior.Color = 65535 Then
dblZ = dblZ + rngc
End If
Next
Range("H105").Value = dblZ
Case 9
If Target.Interior.Color = 255 Then
Target.Interior.Pattern = xlNone
Else
Target.Interior.Color = 255
End If
For Each rngc In Range("I1:I104")
If rngc.Interior.Color = 255 Then
dblZ = dblZ + rngc
End If
Next
Range("I105").Value = dblZ
End Select
End Sub

Bei mir funktioniert der Code.

Gruß
Rainer

Answer 9

Hallo Oliver, hallo Rainer,

erst einmal vielen Dank. Ich bin immer wieder fasziniert, was ihr aus Excel alles raus holen könnt. Gibt es dafür Kurse, oder ist es besser, hier im Forum viel zu lesen und auszuprobieren?

Nun aber noch zu euren Codes.

Beide Codes funktionieren bis auf die Summierung der einzelnen Farben einwandfrei. In Zeile 105 zeigt es in G, H und I jeweils nur die 0 an.

In den Zellen sind nur Texte hinterlegt, die mit der Farbe ausgewählt werden sollen.

VG Florian

Answer 10

Hallo Florian,

schau mal in meine Testmappe, da funktionieren die Summen.

Testmappe

Gruß
Rainer