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