Hi Denis,
so kompliziert ist es nicht Farben mit in eine Formel einzubeziehen. Das Problem liegt vielmehr darin, dass VBA nicht mitbekommt, wenn es eine Farbänderung in Excel gibt. Dafür gibt leider keine Event. Wenn du nach der Berechnung von Formeln Farben anpasst, musst du also manuell auf F9 drücken damit die Formel neu berechnet wird.
Mit Folgendem Code wäre das möglich:
Function AvgClr(TotalRange As Range, Range1 As Range, Condition1, Optional RngColor)
Application.Volatile
Dim clr As Long, i As Long, c As Range, v As Double, x As Long
If TypeName(RngColor) = "Range" Then clr = RngColor.Interior.Color Else clr = Application.Caller.Interior.Color
For i = 1 To TotalRange.Cells.Count
If TotalRange.Cells(i).Interior.Color = clr And Range1(i) = Condition1 Then
v = v + TotalRange.Cells(i).Value
x = x + 1
End If
Next i
AvgClr = v / x
End Function
Da du mit mehreren Messprotokollen arbeitest, schlage ich vor den Code nicht in die Messdatei sondern in ein Modul der Persönlichen Arbeitsmappe zu legen. Falls du vorhast die Berechnung und das Makro weiterzugeben wäre hingegen eine neue Datei, die du dann als Excel-AddIn speicherst, besser geeignet.
Wenn du den Code direkt im Messprotokoll oder in einem AddIn hast kann die Formel so lauten:
=avgclr($E$3:$E$17;$D$3:$D$17;1;E3)
Im ersten Parameter ist der zu summierende und durch die Anzahl gültiger Werte zu teilende Bereich (hier Spalte E), im zweiten Parameter ist der Bereich der die Bedingung im dritten Parameter enthalten muss. Im vierten Parameter gibst du eine Zelle an, nach deren Farbe gesucht werden soll. Diesen Parameter kannst du auch weglassen. =avgclr($E$3:$E$17;$D$3:$D$17;1) Dann wird die Farbe der Zelle verwendet, welche die Formel enthält.
Solltest du dich für den Code in der Persönlichen Arbeitsmappe entscheiden, musst du zusätzlich vor der Formel noch den Namen der Mappe angeben.
=PERSONAL.XLSB!avgclr($E$3:$E$17;$D$3:$D$17;1)
Probiers mal aus und berichte.
Gruß Mr. K.
|