...Und hier noch ein Bsp wie das fktn kann,...
04.03.2010 22:32:38
Luc:-?
…Sonja…
Alles, was in diesem Bsp mit der BedingtFormatierung verbunden ist, kann u.soll nicht Ggstd der nachfolgd PgmCodes sein.
Ins Dokument-Klassenmodul der Tabelle gehört…
Option Explicit
Rem Zum Anpassen an bestehende Bedingg müssen idR nur die Const-Werte geändert wdn!
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const sigZBer As String = "A2", sigZSel As Long = 1
If Target.Cells.Count
In ein „normales“ Modul müssen die ff Prozz eingetragen wdn…
Option Explicit
Rem Zum Anpassen an bestehende Bedingg müssen idR nur die Const-Werte geändert wdn!
Sub ColorRotation(zielZ As Range)
Const fIdx As String = "1;6;10;3;5;7", fmlA As Integer = 4, _
fzOs As String = "1;0;1;2", fzOz As String = "0;5;5;5"
Static fx, so, zo As Variant
Dim i As Long, icx As Integer, znr As Integer, fmlZ() As Range
ReDim fmlZ(fmlA - 1) As Range
If IsEmpty(fx) Then _
fx = Split(fIdx, ";"): so = Split(fzOs, ";"): zo = Split(fzOz, ";")
' fx = Split(fIdx, ";"): so = Split(fzOs, ";"): zo = Split(fzOz, ";") 'f.1.Anleg aktvrn!
icx = zielZ.Interior.ColorIndex
If CBool(InStr(";" & fIdx & ";", ";" & icx & ";")) Then
znr = WorksheetFunction.Match(CStr(icx), fx, 0)
If znr > UBound(fx) Then znr = 0
zielZ.Interior.ColorIndex = fx(znr)
For i = 0 To fmlA - 1
Set fmlZ(i) = zielZ.Offset(zo(i), so(i))
fmlZ(i).Formula = fmlZ(i).Formula
Next i
End If
ReDim fmlZ(0) As Range: Set zielZ = Nothing
End Sub
Function ColorCount(Bereich As Range, FarbIdx As Integer)
Dim x As Range
For Each x In Bereich
If x.Interior.ColorIndex = FarbIdx Then ColorCount = ColorCount + 1
Next x
End Function
Gruß Luc :-?
