AW: SUMME() reicht schon, ...
12.05.2014 14:07:40
fcs
Hallo Werner,
ich hab es jetzt mal im Makro möglichst allgemein formuliert.
im Code musst du noch einige Zeilen anpassen, in denen die Zelle mit dem 1. Namen festgelegt wird und die letzte Spalte, die bedingt formatiert werden soll.
Gruß
Franz
Sub Bedingtformatieren()
' Bedingtformatieren Makro
Dim rng As Range
Dim row1 As Long, rowL As Long
Dim Spalte1 As Long, SPlateL As Long
Dim C1 As String, C2 As String, C3 As String, C4 As String
Dim strFormel As String
Dim wks As Worksheet
Set wks = ActiveSheet
With wks
'Bereich definieren, der bedingt formatiert werden soll
Spalte1 = 4 'Spalte D - 1. zu formatierende Spalte - ggf. anpassen
SpalteL = 7 'Spalte G - letzte zu formatierende Spalte - ggf. anpassen
row1 = 7 '1. zur formatieende Zeile - ggf. anpassen
'letzte zu formatierende Zeile ermitteln
rowL = .Cells(.Rows.Count, Spalte1).End(xlUp).Row
'zu formatierender Bereich
Set rng = .Range(.Cells(row1, Spalte1), .Cells(rowL, SpalteL))
End With
'Buchstaben der in der Formel erscheinenden Spalten
With rng.Range("a1")
C1 = fncBuchstabeSpalte(.Offset(0, 0))
C2 = fncBuchstabeSpalte(.Offset(0, 1))
C3 = fncBuchstabeSpalte(.Offset(0, 2))
C4 = fncBuchstabeSpalte(.Offset(0, 3))
End With
'=SUMMENPRODUKT(($D7=$D$7:$D$13)*($E7=$E$7:$E$13)*($F7=$F$7:$F$13)*($G7=$G$7:$G$13)*($G7="ja")* _
1) >=3
strFormel = "=SUMMENPRODUKT(" _
& "($" & C1 & row1 & "=$" & C1 & "$" & row1 & ":$" & C1 & "$" & rowL & ")" _
& "*($" & C2 & row1 & "=$" & C2 & "$" & row1 & ":$" & C2 & "$" & rowL & ")" _
& "*($" & C3 & row1 & "=$" & C3 & "$" & row1 & ":$" & C3 & "$" & rowL & ")" _
& "*($" & C4 & row1 & "=$" & C4 & "$" & row1 & ":$" & C4 & "$" & rowL & ")" _
& "*($" & C4 & row1 & "=""ja"")*1) >=3"
' Debug.Print strFormel
With rng
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=strFormel
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).StopIfTrue = False
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
End With
End Sub
Function fncBuchstabeSpalte(Zelle As Range) As String
'ermittelt Buchstabe(n) der Spalte in der Adresse der 1. Zelle eines Bereiches
Dim strText As String
strText = Zelle.Range("a1").Address(True, False, xlA1)
strText = Left(strText, InStr(1, strText, "$") - 1)
fncBuchstabeSpalte = strText
End Function