Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bedingte Formatierung auf Bereich anwenden...Hilfe

Bedingte Formatierung auf Bereich anwenden...Hilfe
08.05.2017 14:04:06
Max2
Hallo Leute,
ich erstelle eine Range und möchte auf diese anschließend eine
Benutzerdefinierte bedingte Formatierung anwenden...
Bis Dato sieht das ganze so aus:

dblEingabe = UserForm1.TextBox2.Value
dblProzent = UserForm1.TextBox4.Value
operator = UserForm1.ComboBox3.Value
If use_Percent Then dblEingabe = dblEingabe * (dblProzent / 100)
sFormel = "=UND(" & ActiveCell.Address & operator & dblEingabe & _
";" & ActiveCell.Address & """""" & ";" & _
ActiveCell.Address & dblEingabe & """"")"
Set ws = ThisWorkbook.Sheets(wsName)
With ws
j = .Cells(x, .Columns.Count).End(xlToLeft).Column
Set rng = .Range(.Cells(x, 1), .Cells(y, j))
rng.FormatConditions.Delete
rng.FormatConditions.Add Type:=xlCellValue, Formula1:=sFormel
rng.FormatConditions(1).Interior.ColorIndex = arrColor(1, i)
Jetzt ist natürlich das Problem dass die Formel einen absoluten Zellbezug haben.
Wie kann ich eine Formel auf alle Zellen eines Bereichs setzten?
Muss ich jede Zelle einmal abklappern?

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Andere Idee durch Rekorder
08.05.2017 14:13:26
Max2
Hallo Leute,
war natürlich so schlau und habe den Rekorder erst jetzt bemüht...

Sub Makro1()
' Makro1 Makro
Range("A5864:BW7494").Select
Selection.FormatConditions.Add Type:=xlCellValue, operator:=xlGreater, _
Formula1:="=6"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
Da eigentlich nur der Operator, der durch den Nutzer festgelegt wird ein "Problem" darstellt, könnte ich das ganze eigentlich doch auch mit einem Select Case machen oder?
select Case Operator
Case ">"
Selection.FormatConditions.Add Type:=xlCellValue, operator:=xlGreater
Case "
usw....
Anzeige
Hier Lösung
09.05.2017 11:11:26
Max2
Hallo,
unten der Code der Zellen einfärbt, ersetzt, oder löscht.
Prüft welcher Operator ausgewählt wurde und vergleicht dann die Werte in Bool Funktionen.

Sub add_color(ByVal x As Long, y As Long)
Dim arrColors() As Variant
Dim i As Integer
Dim j As Long
Dim rng As Range, c As Range
Dim ws As Worksheet
Dim wsName As String
'färbt zellen mit bestimmten werten, je nach auswahl, ein.
ReDim arrColors(1, 5)
arrColors(1, 0) = 3: arrColors(0, 0) = "rot"
arrColors(1, 1) = 45: arrColors(0, 1) = "orange"
arrColors(1, 2) = 6: arrColors(0, 2) = "gelb"
arrColors(1, 3) = 4: arrColors(0, 3) = "grün"
arrColors(1, 4) = 5: arrColors(0, 4) = "blau"
arrColors(1, 5) = 2: arrColors(0, 5) = "weiß"
For j = 0 To 5
If UserForm1.ComboBox4.Value = arrColors(0, j) Then
i = j
Exit For
End If
Next j
Application.ScreenUpdating = False
wsName = UserForm1.ComboBox2.Value
Set ws = ThisWorkbook.Sheets(wsName)
With ws
j = .Cells(x, .Columns.Count).End(xlToLeft).Column
Set rng = .Range(.Cells(x, 1), .Cells(y, j))
For Each c In rng
If ergebnisOP(c.Value) And c.Value  "x" Then
c.Interior.ColorIndex = arrColors(1, i)
End If
Next c
End With
Application.ScreenUpdating = True
End Sub
Sub replace_value(ByVal x As Long, y As Long)
Dim i As Integer
Dim j As Long
Dim rng As Range, c As Range
Dim ws As Worksheet
Dim wsName As String
Dim replacement As String
'ersetzt bestimmte Zellwerte mit Eingabe
replacement = UserForm1.TextBox3.Value
Application.ScreenUpdating = False
wsName = UserForm1.ComboBox2.Value
Set ws = ThisWorkbook.Sheets(wsName)
With ws
j = .Cells(x, .Columns.Count).End(xlToLeft).Column
Set rng = .Range(.Cells(x, 1), .Cells(y, j))
For Each c In rng
If ergebnisOP(c.Value) Then
c.Value = replacement
End If
Next c
End With
Application.ScreenUpdating = True
End Sub
Sub erase_value(ByVal x As Long, y As Long)
Dim i As Integer
Dim j As Long
Dim rng As Range, c As Range
Dim ws As Worksheet
Dim wsName As String
'Löscht bestimmte Zellwerte
Application.ScreenUpdating = False
wsName = UserForm1.ComboBox2.Value
Set ws = ThisWorkbook.Sheets(wsName)
With ws
j = .Cells(x, .Columns.Count).End(xlToLeft).Column
Set rng = .Range(.Cells(x, 1), .Cells(y, j))
For Each c In rng
If ergebnisOP(c.Value) Then
c.Value = ""
End If
Next c
End With
Application.ScreenUpdating = True
End Sub
Function ergebnisOP(ByVal i) As Boolean
'ermittelt welcher Operator
'ausgewählt wurde und ruft dann eine Funktion auf
'die den Zellwert mit dem Vergleichswert und dem
'operator prüft
Select Case op
Case ""
ergebnisOP = greater(i)
Case "="
ergebnisOP = greater_eq(i)
Case "="
ergebnisOP = equals(i)
End Select
End Function
Function greater(ByVal i) As Boolean
'ist größer?
If i > dblEingabe Then greater = True
End Function
Function less(ByVal i) As Boolean
'ist kleiner?
If i = dblEingabe Then greater_eq = True
End Function
Function less_eq(ByVal i) As Boolean
'kleiner gleich?
If i 

Anzeige

315 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige