Thema Datum  Von Nutzer Rating
Antwort
05.12.2016 12:58:43 ChrisKay86
NotSolved
Blau Bedingte Formatierung mit Variablen Werten
 05.12.2016 14:45:41 BigBen
*****
NotSolved
05.12.2016 14:49:29 BigBen
NotSolved
05.12.2016 15:39:57 ChrisKay86
NotSolved
05.12.2016 17:04:02 BigBen
NotSolved
05.12.2016 17:44:45 ChrisKay86
NotSolved
06.12.2016 21:47:26 BigBen
NotSolved
07.12.2016 05:44:23 ChrisKay86
NotSolved
07.12.2016 14:13:25 BigBen
NotSolved
07.12.2016 14:24:43 BigBen
NotSolved
08.12.2016 08:47:39 ChrisKay86
NotSolved
08.12.2016 12:55:44 BigBen
NotSolved
11.12.2016 01:21:32 BigBen
*****
NotSolved
16.12.2016 07:06:37 ChrisKay86
NotSolved
28.12.2016 16:44:20 BigBen
NotSolved
07.12.2016 14:47:26 BigBen
NotSolved

Ansicht des Beitrags:
Von:
BigBen		 Datum:
05.12.2016 14:45:41		 Views:
1012		 Rating:
     
Antwort:
  Ja
Thema:
Bedingte Formatierung mit Variablen Werten

Hallo,

habe eine Arbeitsmappe erstellt.

Diese kannst Du hier herunterladen: https://www.dropbox.com/s/6aacow37gtsnoxr/Bedingte%20Formatierung%20Daten.xlsm?dl=0

Bei dieser Lösung habe i ch einen Ansatz gewählt, bei der direkt nach dem Ändern einer Zelle in der Daten-Tabelle die Zelle geprüft wird.

Modul modTypes:

?
1
2
3
4
5
6
Public Type Grenzwerte
    Sollwert As Long
    ToleranzOben As Long
    ToleranzUnten As Long
    Durchmesser As String
End Type

Tabelle Daten:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myCnf As New clsConfig
    Application.EnableEvents = False
    Dim Data As Grenzwerte
    Data = myCnf.ReadGrenzwerte(Target)
     
    If Target.Value = "" Then
        Target.Interior.ColorIndex = 15
    Else
        If Data.Durchmesser = "aussen" Then
            Target.Interior.ColorIndex = 38 ' rot
            If Target.Text <= Data.Sollwert + Data.ToleranzOben And Target.Text >= Data.Sollwert + Data.ToleranzUnten Then Target.Interior.ColorIndex = 10 ' grün
            If Target.Text > Data.Sollwert + Data.ToleranzOben Then Target.Interior.ColorIndex = 36 ' gelb
        ElseIf Data.Durchmesser = "innen" Then
            If Target.Text = "" Then
                Target.Interior.ColorIndex = 15 ' leere Zelle grau färben
            Else
                Target.Interior.ColorIndex = 38 'rot
                If Target.Text <= (Data.Sollwert + Data.ToleranzOben) And Target.Text >= (Data.Sollwert + Data.ToleranzUnten) Then Target.Interior.ColorIndex = 10 'grün
                If Target.Text < (Data.Sollwert + Data.ToleranzUnten) Then Target.Interior.ColorIndex = 36 'gelb
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

Klasse clsConfig:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Function GetDataRange() As Range
    With Worksheets("Einstellungen")
        Set GetDataRange = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 5))
    End With
End Function
 
Function ReadGrenzwerte(Target As Range) As Grenzwerte
    Dim rngData As Range
    Dim rngCells As Range
    Dim rngRead As Range
    Set rngData = GetDataRange
    For Each rngCells In rngData.Columns(1).Cells
        If Left(rngCells.FormulaR1C1, 1) = "=" Then
            If Not Intersect(Range(rngCells.FormulaLocal), Target) Is Nothing Then
                For Each rngRead In Intersect(rngData, rngCells.EntireRow).Cells
                    Select Case rngRead.Column
                        Case 2
                            ReadGrenzwerte.Sollwert = rngRead.Value
                        Case 3
                            ReadGrenzwerte.ToleranzOben = rngRead.Value
                        Case 4
                            ReadGrenzwerte.ToleranzUnten = rngRead.Value
                        Case 5
                            ReadGrenzwerte.Durchmesser = rngRead.Value
                        Case Else
                    End Select
                Next
                Exit For
            End If
        End If
    Next
End Function

Damit diese Lösung funktioniert, muss in der Tabelle "Einstellungen" folgende Inhalte eingefügt werden:

Spalte Sollwert ToleranzOben ToleranzUnten Durchmesser
Formel 20 5 7 innen
Formel 25 7 3 aussen

Die Werte können natürlich angepasst werden.

Im Feld Spalte muss ein Verweis zu der Spalte eingesetzt werden:

Bsp: A2: =Daten!A:A
A3: =Daten!B:B

In der Tabelle "Daten" stehen nur noch die auszuwertenden Zahlen wie Bsp.:

12 45
6 6
4  
34  
87  
3  
6  
15  
17  

Die Tabelle 1 wird nicht benötigt. Diese wrde nur als Testtabelle eingefügt, um zu sehen, wie der VBA-Code funktioniert

LG, BigBen

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.12.2016 12:58:43 ChrisKay86
NotSolved
Blau Bedingte Formatierung mit Variablen Werten
 05.12.2016 14:45:41 BigBen
*****
NotSolved
05.12.2016 14:49:29 BigBen
NotSolved
05.12.2016 15:39:57 ChrisKay86
NotSolved
05.12.2016 17:04:02 BigBen
NotSolved
05.12.2016 17:44:45 ChrisKay86
NotSolved
06.12.2016 21:47:26 BigBen
NotSolved
07.12.2016 05:44:23 ChrisKay86
NotSolved
07.12.2016 14:13:25 BigBen
NotSolved
07.12.2016 14:24:43 BigBen
NotSolved
08.12.2016 08:47:39 ChrisKay86
NotSolved
08.12.2016 12:55:44 BigBen
NotSolved
11.12.2016 01:21:32 BigBen
*****
NotSolved
16.12.2016 07:06:37 ChrisKay86
NotSolved
28.12.2016 16:44:20 BigBen
NotSolved
07.12.2016 14:47:26 BigBen
NotSolved