Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1332to1336
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Summen von fabrigen Zellen

Summen von fabrigen Zellen
04.10.2013 11:18:14
fabrigen
Hallo an alle,
ich habe mal wieder ein Problem und hoffe auf Hilfe. Ich füge ein Beispiel anbei.
https://www.herber.de/bbs/user/87537.xls
Ich hätte gerne mit einem Makro die Möglichkeit die Summen der farbigen Zellen zu
addieren.
Im Moment habe ich zwar drei Farben, jedoch ist es veilleicht nötig mehrere Farben
oder bzw. andere Farben zu nutzen.
Wäre dankbar für eine Hilfe
Gruß
Dietmar

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Summen von fabrigen Zellen
04.10.2013 11:36:32
fabrigen
Super Hajo, da habe ich ja sogar mehrere Variationen.
Vielen Dank
Gruß
Dietmar

AW: Summen von fabrigen Zellen
04.10.2013 13:20:36
fabrigen
Hallo Dietmar,
das könnte auch so funktionieren:
Option Explicit
Public Sub Nach_Farben_addieren()
Dim Dic_Zaehlen  As Object
Dim Dic_Summe    As Object
Dim rBereich     As Range
Dim rZelle       As Range
Dim lZeile       As Long
ThisWorkbook.Worksheets("Tabelle5").Activate
Set Dic_Zaehlen = CreateObject("Scripting.Dictionary")
Set Dic_Summe = CreateObject("Scripting.Dictionary")
Dic_Zaehlen("Farbe") = "Anzahl"
Dic_Summe("Farbe") = "Summe"
Set rBereich = Range("B5:E" & Cells(Rows.Count, 2).End(xlUp).Row) '.CurrentRegion
For Each rZelle In rBereich
Dic_Zaehlen(rZelle.Interior.ColorIndex) = Dic_Zaehlen(rZelle.Interior.ColorIndex) + 1      _
' das Item um 1 hochzählen
Dic_Summe(rZelle.Interior.ColorIndex) = Dic_Summe(rZelle.Interior.ColorIndex) + rZelle. _
Value ' den Wert in B zu dem Item dazuaddieren.
Next rZelle
'    Ausgabe in H:I
Range("H4").Resize(Dic_Zaehlen.Count) = WorksheetFunction.Transpose(Dic_Zaehlen.keys)
Range("I4").Resize(Dic_Zaehlen.Count) = WorksheetFunction.Transpose(Dic_Zaehlen.Items)
Range("J4").Resize(Dic_Zaehlen.Count) = WorksheetFunction.Transpose(Dic_Summe.Items)
For lZeile = 5 To Cells(Rows.Count, 8).End(xlUp).Row - 1
Range("H" & lZeile).Interior.ColorIndex = Range("H" & lZeile).Value
Next lZeile
Range("H" & lZeile).Value = "Gesamt"
End Sub

Gruß Peter

Anzeige
AW: Summen von fabrigen Zellen
05.10.2013 11:51:17
fabrigen
Hallo Peter,
vielen Dank für deinen Vorschlag. Meine Kentnisse sind jedoch nicht so gut um jetzt zu wissen was ich
machen soll.
Bitte geben mir doch die Schritte auf die ich noch machen muss.
Vielen Dank
Dietmar

AW: Summen von fabrigen Zellen
05.10.2013 13:50:49
fabrigen
Hallo Dietmar,
kopier Dir die beigefügte Mappe, da ist alles enthalten.
Du musst nur noch auf den Button klicken.
https://www.herber.de/bbs/user/87546.xls
Gruß Peter

AW: Summen von fabrigen Zellen
05.10.2013 14:02:57
fabrigen
Hallo Peter,
supper vielen Dank für deine Hilfe.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige