Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema RefEdit
BildScreenshot zu RefEdit RefEdit-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Bedingte Formatierung auf Bereich anwenden...Hilfe


Betrifft: Bedingte Formatierung auf Bereich anwenden...Hilfe von: Max2
Geschrieben am: 08.05.2017 14:04:06

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?

  

Betrifft: Andere Idee durch Rekorder von: Max2
Geschrieben am: 08.05.2017 14:13:26

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 "<"
Selection.FormatConditions.Add Type:=xlCellValue, operator:=xlLess
usw....


  

Betrifft: Hier Lösung von: Max2
Geschrieben am: 09.05.2017 11:11:26

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 = less(i)
        Case ">"
            ergebnisOP = greater(i)
        Case "<="
            ergebnisOP = less_eq(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 less = True

End Function


Function greater_eq(ByVal i) As Boolean

'größer gleich?

    If i >= dblEingabe Then greater_eq = True

End Function


Function less_eq(ByVal i) As Boolean

'kleiner gleich?

    If i <= dblEingabe Then less_eq = True

End Function


Function equals(ByVal i) As Double

'ist gleich?

    If i = dblEingabe Then equals = True
    
End Function




Beiträge aus den Excel-Beispielen zum Thema "Bedingte Formatierung auf Bereich anwenden...Hilfe"