1.8k Aufrufe
Gefragt in Tabellenkalkulation von
Ich möchte die Formel auch in Spalte C und D usw. anwenden. Nicht nur in Spalte B. Was muss noch eingegeben werden?

Sub Farben()

Dim i As Integer
Dim sumblau As Long
Dim sumrot As Long
Dim sumschwarz As Long

sumblau = 0
sumrot = 0
sumschwarz = 0
'Ergebnisfelder initialisieren
Range("b28").Select: ActiveCell.Value = 0
Range("b29").Select: ActiveCell.Value = 0
Range("b30").Select: ActiveCell.Value = 0


'schwarz
Range("b2").Select
For i = 1 To 27
If Selection.Font.ColorIndex = xlAutomatic Then sumschwarz = sumschwarz + ActiveCell.Value
ActiveCell.Offset(1, 0).Range("A1").Select
Next
Range("b28").Select
ActiveCell.Value = sumschwarz


'jetzt rote Einträge summieren
Range("b2").Select
For i = 1 To 27
If Selection.Font.ColorIndex = 3 Then sumrot = sumrot + ActiveCell.Value
ActiveCell.Offset(1, 0).Range("A1").Select
Next
Range("b29").Select
ActiveCell.Value = sumrot



' blau abchecken
Range("b2").Select
For i = 1 To 27
If Selection.Font.ColorIndex = 5 Then sumblau = sumblau + ActiveCell.Value
ActiveCell.Offset(1, 0).Range("A1").Select
Next
Range("b30").Select
ActiveCell.Value = sumblau

End Sub

4 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

das folgende Makro berechnet die Farbenwerte in den Zeilen 2 bis 27 in der Spalte, in der sich der Cursor befindet:

Sub Farben_neu()

Dim i As Integer
Dim sumblau As Long
Dim sumrot As Long
Dim sumschwarz As Long
Dim zeile, spalte As Long

sumblau = 0
sumrot = 0
sumschwarz = 0

spalte = ActiveCell.Column

For zeile = 2 To 27

'schwarze Einträge summieren
If Cells(zeile, spalte).Font.ColorIndex = xlAutomatic Then sumschwarz = sumschwarz + Cells(zeile, spalte).Value

'rote Einträge summieren
If Cells(zeile, spalte).Font.ColorIndex = 3 Then sumrot = sumrot + Cells(zeile, spalte).Value

'blaue Einträge summieren
If Cells(zeile, spalte).Font.ColorIndex = 5 Then sumblau = sumblau + Cells(zeile, spalte).Value

Next zeile

Cells(28, spalte) = sumschwarz
Cells(29, spalte) = sumrot
Cells(30, spalte) = sumblau

End Sub


Gruß

M.O.
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi all ^^

gruss nighty

Function WksWert(Zellen As Range, FarbIndex As Long) As Long
Dim Zelle As Range
For Each Zelle In Zellen
If Cells(Zelle.Row, Zelle.Column).Interior.ColorIndex = FarbIndex Then
WksWert = WksWert + Cells(Zelle.Row, Zelle.Column)
End If
Next Zelle
End Function
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi all ^^

einzufuegen
alt + f11/projektexplorer/allgemeines modul

die function ist nun unter einfuegen function benutzerdefiniert erreichbar

z.b.

=WksWert(A2:A5;3)

farbindex waere bei diesem beispiel die 3 fuer rot

gruss nighty
0 Punkte
...