Zeilen mit Doppelklick einfärben und Summe bilden

Question

Hallo Zusammen,

ich habe hier im Forum einen Code bekommen (hierfür nochmals vielen Dank an R. und O.) , mit dem man mit einem Doppelklick in Spalte G, H und I unterschiedliche Farben bekommt. Beim erneuten Doppelklick werden diese Farben wieder auf "Keine Füllung" zurück gestellt. Zusätzlich summiert der Code alle gleichen Farbzellen.

Nun müsste ich die Farben und Summen nicht mehr Spaltenweise, sondern Zeilenweise haben.

Es beschränkt sich "nur" auf die Zeilen 8 bis 10 und 12 bis 14. Die Summe soll in der jeweiligen Zeile in Spalte L erscheinen.

Da ich noch schwer im lernen bin, wie die Makros richtig zu formulieren sind, benötige ich hierfür eure Hilfe.


Code für Spalten folgt gleich!


VG Florian

Answer 1

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

Answer 2

Hallo Florian!

Welche Zeile welche Farbe zählen?
Von welcher Spalte bis zu welcher Spalte sollen die farbigen Zellen gezählt werden?
Welches Makro benutzt Du?

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 3

Hallo Florian,

da Du noch lernen willst, anbei ein Beispiel was Du nach Deinen Vorgaben anpassen kannst.

Beispiel

Gruß
Rainer

Answer 4

Danke Rainer.

Kannst du mir noch kurz den Code erklären?


Dim rngZelle As Range
Dim dblSumme As Double

Select Case Target.Column


Danke.

Gruß Florian

Answer 5

Hallo Florian,

Dim rngZelle As Range
- die wahlfreie Variable rngZelle wird hier als Range deklariert

Dim dblSumme As Double
- die wahlfreie Variable dblSumme wird hier als Double (Gleitkommazahl mit doppelter Genauigkeit) deklariert

Select Case Target.Column
- die Case-Anweisung führt immer eine von mehreren Anweisungen aus, welche vom zugewiesenen Wert abhängig sind. Der zugewiesene Wert Target.Column, ist in diesem Falle der jeweils angesprochene Spaltenindex.

Das kann man übrigens auch in der Hilfe erfahren.

Gruß
Rainer

Answer 6

Hallo Florian,

falls Du noch mal reinschaust.
Für Dein letztes Problem würde ich folgenden Code verwenden.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngC As Range, dblZ As Double, intFarbe As Integer
If Not Intersect(Target, Range("A8:K8,A10:K10,A12:K12,A14:K14")) Is Nothing Then
On Error Resume Next
Select Case Target.Row
Case 8
If Target.Interior.ColorIndex = 4 Then
Target.Interior.Pattern = xlNone
Else
Target.Interior.ColorIndex = 4
End If
intFarbe = 4
Case 10
If Target.Interior.ColorIndex = 6 Then
Target.Interior.Pattern = xlNone
Else
Target.Interior.ColorIndex = 6
End If
intFarbe = 6
Case 12
If Target.Interior.ColorIndex = 3 Then
Target.Interior.Pattern = xlNone
Else
Target.Interior.ColorIndex = 3
End If
intFarbe = 3
Case 14
If Target.Interior.ColorIndex = 5 Then
Target.Interior.Pattern = xlNone
Else
Target.Interior.ColorIndex = 5
End If
intFarbe = 5
End Select
For Each rngC In Range(Cells(Target.Row, 1), Cells(Target.Row, 11))
If rngC.Interior.ColorIndex = intFarbe Then
dblZ = dblZ + rngC
End If
Next
Cells(Target.Row, 12).Value = dblZ
End If
End Sub

Gruß
Rainer