Naja, ich sagte ja bereits, was auf Basis ...
23.07.2014 21:56:56
Luc:-?
…deines Versuchs getan wdn müsste, Tom!
Ich bin jetzt auch bei deinem Ansatz geblieben (normalerweise würde ich das etwas anders lösen), damit es dir verständlicher ist und du außerdem noch gewisse Effekte kennenlernst.
Option Explicit 'sollte immer in der 1.Zeile 1es Moduls stehen!
Sub SumMarkZ()
Const adErgBer$ = "D3:D12", adRelBer$ = "H#:CZ#"
Dim ergBer As Range, x As Range, z As Range
Set ergBer = Me.Range(adErgBer): ergBer.ClearContents
For Each x In ergBer
For Each z In Me.Range(Replace(adRelBer, "#", x.Row))
If z.Interior.ColorIndex > 0 Then x = x + z
Next z
Next x
Set ergBer = Nothing
End Sub
Allerdings musst du bei Änderungen die Neuberechnung so stets manuell starten. Das passiert nicht von allein. Bei einer UDF wie bspw FarbSumme könnte ein Klick in eine beliebige (bzw eine der umgefärbten) Zelle(n) reichen. Bei FarbÜbernahme per Pinsel wäre nicht mal das erforderlich.
Gruß, Luc :-?