Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1076to1080
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellen bedingt farblich hinterlegen

Zellen bedingt farblich hinterlegen
03.06.2009 20:58:16
Patrick
Hi,
ich habe folgendes Problem: ich möchte so wie im Screenshot gezeigt Zellen bzw. ganze Zeilen farblich bedingt formatieren.
Es gibt pro Zeile zwei Werte (Spalten W und X) sowie deren Produkt (Spalte Y). Die W, X und Y sind auch nochmal als grafische Matrix links im Bild zu sehen, incl. der gewünschten farblichen Hervorhebung (3,5/3,5 soll orange werden, 2,5/2 soll gelb werden etc) die später auf Spalte Y angewandt werden soll. So soll z.B. der Wert 6,25 in Spalte W orange dargestellt werden (weil die Mtrix links das so festlegt UND VORGIBT). WICHTIG: Ich möchte also nicht die Matrix links farblich hinterlegen, sondern es geht nur um Spalte W.
Link zum Screenshot: http://s2b.directupload.net/file/d/1814/moaim8bp_jpg.htm
Mit der excelinternen bedingten Formatierung (OfficeXP, ist also Excel 2002) ist das wohl nicht zu machen, da ich zum einen nur drei Bedinungen hinterlegen kann, ich aber fuenf (weil 5 Farbtöne) bräuchte, zum anderen weil nur das Produkt aus W und X alleine nicht für die Farbgebung ausreichend ist (Bsp: Y = 9, bei W=2 und X=4,5 wäre rot richtig, bei W=3 und X=3 aber nur orange).
Ich selbst hab leider recht wenig Schimmer, ob sich die Sache überhaupt lösen lässt... vielleicht sitzt ja hier ein Excelgott und wartet nur auf solche Aufgaben

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellen bedingt farblich hinterlegen
03.06.2009 21:58:04
LukiLeu
Hallo
Ich habe dir mal einen Code geschrieben. Ich hoffe er macht im Grossen und Ganzen das, was du gewünscht hast.
In ein Modul:

Sub Farbe()
Dim MatrixStartS        'Bei welcher Spalte beginnt die Matrix? A=1, B=2, ...
Dim MatrixStartZ        'Bei welcher Zeile beginnt die Matrix?
Dim Start
Dim Ende
Dim Grösse              'Wieviele breit/lang ist die Matrix?
Dim AnzahlZellen        'Wieviele Linien in den Spalten W, X, Y sollen angeschaut werden?
Dim i
Dim e
Dim MatrixStartS_Temp
Dim MatrixStartZ_Temp
MatrixStartS = 1
MatrixStartZ = 1
Grösse = 10
AnzahlZellen = 5        'wäre von Y1 bis Y5
Start = Cells(MatrixStartS + 1, MatrixStartZ)
Ende = Cells(MatrixStartS + Grösse - 1, MatrixStartZ)
For i = 1 To AnzahlZellen
If (Range("W" & i) >= Start And Range("X" & i) >= Start And Range("W" & i) 


In diese Arbeitsmappe:


Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call Farbe
End Sub


Hier findest du meine erstellte Arbeitsmappe:
ww.herber.de/bbs/user/62204.xls
Gruss
LukiLeu

Anzeige
AW: Zellen bedingt farblich hinterlegen
03.06.2009 22:01:18
Josef
Hallo Patrik,
nächstesmal bitte eine Tabelle hochladen, Excel kann aus einem Bild keine Tabelle generieren!
Diesen Code in das Modul der Tabelle.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sngValues(1 To 9) As Single
  Dim lngColors(1 To 9, 1 To 9) As Long
  Dim varRes As Variant
  
  sngValues(1) = 1
  sngValues(2) = 1.5
  sngValues(3) = 2
  sngValues(4) = 2.5
  sngValues(5) = 3
  sngValues(6) = 3.5
  sngValues(7) = 4
  sngValues(8) = 4.5
  sngValues(9) = 5
  
  lngColors(1, 1) = 14
  lngColors(1, 2) = 14
  lngColors(1, 3) = 14
  lngColors(1, 4) = 6
  lngColors(1, 5) = 6
  lngColors(1, 6) = 45
  lngColors(1, 7) = 45
  lngColors(1, 8) = 3
  lngColors(1, 9) = 3
  lngColors(2, 1) = 14
  lngColors(2, 2) = 14
  lngColors(2, 3) = 6
  lngColors(2, 4) = 6
  lngColors(2, 5) = 6
  lngColors(2, 6) = 45
  lngColors(2, 7) = 45
  lngColors(2, 8) = 3
  lngColors(2, 9) = 3
  lngColors(3, 1) = 14
  lngColors(3, 2) = 6
  lngColors(3, 3) = 6
  lngColors(3, 4) = 6
  lngColors(3, 5) = 45
  lngColors(3, 6) = 45
  lngColors(3, 7) = 45
  lngColors(3, 8) = 3
  lngColors(3, 9) = 3
  lngColors(4, 1) = 6
  lngColors(4, 2) = 6
  lngColors(4, 3) = 6
  lngColors(4, 4) = 45
  lngColors(4, 5) = 45
  lngColors(4, 6) = 45
  lngColors(4, 7) = 45
  lngColors(4, 8) = 3
  lngColors(4, 9) = 3
  lngColors(5, 1) = 6
  lngColors(5, 2) = 6
  lngColors(5, 3) = 45
  lngColors(5, 4) = 45
  lngColors(5, 5) = 45
  lngColors(5, 6) = 45
  lngColors(5, 7) = 45
  lngColors(5, 8) = 3
  lngColors(5, 9) = 3
  lngColors(6, 1) = 45
  lngColors(6, 2) = 45
  lngColors(6, 3) = 45
  lngColors(6, 4) = 45
  lngColors(6, 5) = 45
  lngColors(6, 6) = 45
  lngColors(6, 7) = 3
  lngColors(6, 8) = 3
  lngColors(6, 9) = 3
  lngColors(7, 1) = 45
  lngColors(7, 2) = 45
  lngColors(7, 3) = 45
  lngColors(7, 4) = 45
  lngColors(7, 5) = 45
  lngColors(7, 6) = 3
  lngColors(7, 7) = 3
  lngColors(7, 8) = 3
  lngColors(7, 9) = 13
  lngColors(8, 1) = 3
  lngColors(8, 2) = 3
  lngColors(8, 3) = 3
  lngColors(8, 4) = 3
  lngColors(8, 5) = 3
  lngColors(8, 6) = 3
  lngColors(8, 7) = 3
  lngColors(8, 8) = 13
  lngColors(8, 9) = 13
  lngColors(9, 1) = 3
  lngColors(9, 2) = 3
  lngColors(9, 3) = 3
  lngColors(9, 4) = 3
  lngColors(9, 5) = 3
  lngColors(9, 6) = 3
  lngColors(9, 7) = 13
  lngColors(9, 8) = 13
  lngColors(9, 9) = 13
  
  With Target
    If .Column = 23 Or .Column = 24 Then
      If .Count = 1 Then
        varRes = Application.Index(lngColors, Application.Match(Cells(.Row, 23), sngValues, 0), Application.Match(Cells(.Row, 24), sngValues, 0))
        If IsNumeric(varRes) Then
          Cells(.Row, 25).Interior.ColorIndex = varRes
        Else
          Cells(.Row, 25).Interior.ColorIndex = xlNone
        End If
      End If
    End If
  End With
End Sub

Gruß Sepp

Anzeige
AW: Zellen bedingt farblich hinterlegen
04.06.2009 08:08:33
Patrick
Hallo, sorry wegen dem Bild, ich habe übersehen, daß ich überhaupt Files hochladen kann.
Ich habe jetzt mal die Tabelle direkt hochgeladen.
Ich kann mit den beiden Antworten allerdings noch nichts anfangen, da ich nicht weiß, wie ich die beiden Quellcodes in meine Tabelle einbaue/-binde und wie ich damit die farbliche Hervorhebung machen: mit VBA oder so hatte ich bisher noch nichts zu tun.
Kann ich hier vielleicht eine Art Step-By-Step Hilfe bekommen?
Danke sehr

Die Datei https://www.herber.de/bbs/user/62206.xls wurde aus Datenschutzgründen gelöscht


Anzeige
AW: Zellen bedingt farblich hinterlegen
04.06.2009 20:25:03
LukiLeu
Hallo
Ich habe den Code noch ein bisschen angepasst und einmal in deine Arbeitsmappe eingefügt. Die Farben und Werte können direkt in der Matrix abgeändert werden, und werden von dort ausgelesen.
Die Einstellungen habe ich schon gemacht:

MatrixStartS = 12
MatrixStartZ = 2
Grösse = 10
AnzahlZellen = 100        'wäre von Y1 bis Y5
'--------------------


Die angepasste Datei findest du hier:
https://www.herber.de/bbs/user/62221.xls
Gruss
LukiLeu

AW: Zellen bedingt farblich hinterlegen
04.06.2009 20:43:16
LukiLeu
Hallo
Ich habe den Code noch ein bisschen angepasst und einmal in deine Arbeitsmappe eingefügt. Die Farben und Werte können direkt in der Matrix abgeändert werden, und werden von dort ausgelesen.
Die Einstellungen habe ich schon gemacht:

MatrixStartS = 12
MatrixStartZ = 2
Grösse = 10
AnzahlZellen = 100        'wäre von Y1 bis Y5
'--------------------


Die angepasste Datei findest du hier:
https://www.herber.de/bbs/user/62221.xls
Gruss
LukiLeu

Anzeige
AW: Zellen bedingt farblich hinterlegen
05.06.2009 11:08:02
Patrick
Hallo Sepp, Hallo LukilLeu,
vielen Dank für eure Hilfe.
Die Lösung von Sepp würde ich gerne verwenden - dazu noch zwei Fragen:
1) an welcher Stelle muß ich denn etwas ändern, wenn die Spalten, die die Farbgebung beeinflußen (im Beispiel W und X) sowie die Zelle, die farblich geändert werden muß (im Beispiel Y) zu ändern.
In meinem "Einsatzbereich" sollten die Werte der Spalte E und F (im Bereich 2 bis 2000) die Farbe der Spalte D (2-2000) beeinflußen.
2) Was muß ich alles aus der Beispielexceldatei in meine Datei kopieren etc. damit das auch dort funktioniert
Vielen, vielen Dank euch beiden schon jetzt
Patrick
Anzeige
AW: Zellen bedingt farblich hinterlegen
05.06.2009 19:59:26
Josef
Hallo Patrick,
der angepasste Code für deine gewünschten Spalten, je nachdem welcjh Version du willst.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

'Beispiel ohne Farbtabelle

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sngValues(1 To 9) As Single
  Dim lngColors(1 To 9, 1 To 9) As Long
  Dim varRes As Variant
  
  sngValues(1) = 1
  sngValues(2) = 1.5
  sngValues(3) = 2
  sngValues(4) = 2.5
  sngValues(5) = 3
  sngValues(6) = 3.5
  sngValues(7) = 4
  sngValues(8) = 4.5
  sngValues(9) = 5
  
  lngColors(1, 1) = 50
  lngColors(1, 2) = 50
  lngColors(1, 3) = 50
  lngColors(1, 4) = 6
  lngColors(1, 5) = 6
  lngColors(1, 6) = 44
  lngColors(1, 7) = 44
  lngColors(1, 8) = 3
  lngColors(1, 9) = 3
  lngColors(2, 1) = 50
  lngColors(2, 2) = 50
  lngColors(2, 3) = 6
  lngColors(2, 4) = 6
  lngColors(2, 5) = 6
  lngColors(2, 6) = 44
  lngColors(2, 7) = 44
  lngColors(2, 8) = 3
  lngColors(2, 9) = 3
  lngColors(3, 1) = 50
  lngColors(3, 2) = 6
  lngColors(3, 3) = 6
  lngColors(3, 4) = 6
  lngColors(3, 5) = 44
  lngColors(3, 6) = 44
  lngColors(3, 7) = 44
  lngColors(3, 8) = 3
  lngColors(3, 9) = 3
  lngColors(4, 1) = 6
  lngColors(4, 2) = 6
  lngColors(4, 3) = 6
  lngColors(4, 4) = 44
  lngColors(4, 5) = 44
  lngColors(4, 6) = 44
  lngColors(4, 7) = 44
  lngColors(4, 8) = 3
  lngColors(4, 9) = 3
  lngColors(5, 1) = 6
  lngColors(5, 2) = 6
  lngColors(5, 3) = 44
  lngColors(5, 4) = 44
  lngColors(5, 5) = 44
  lngColors(5, 6) = 44
  lngColors(5, 7) = 44
  lngColors(5, 8) = 3
  lngColors(5, 9) = 3
  lngColors(6, 1) = 44
  lngColors(6, 2) = 44
  lngColors(6, 3) = 44
  lngColors(6, 4) = 44
  lngColors(6, 5) = 44
  lngColors(6, 6) = 44
  lngColors(6, 7) = 3
  lngColors(6, 8) = 3
  lngColors(6, 9) = 3
  lngColors(7, 1) = 44
  lngColors(7, 2) = 44
  lngColors(7, 3) = 44
  lngColors(7, 4) = 44
  lngColors(7, 5) = 44
  lngColors(7, 6) = 3
  lngColors(7, 7) = 3
  lngColors(7, 8) = 3
  lngColors(7, 9) = 13
  lngColors(8, 1) = 3
  lngColors(8, 2) = 3
  lngColors(8, 3) = 3
  lngColors(8, 4) = 3
  lngColors(8, 5) = 3
  lngColors(8, 6) = 3
  lngColors(8, 7) = 3
  lngColors(8, 8) = 13
  lngColors(8, 9) = 13
  lngColors(9, 1) = 3
  lngColors(9, 2) = 3
  lngColors(9, 3) = 3
  lngColors(9, 4) = 3
  lngColors(9, 5) = 3
  lngColors(9, 6) = 3
  lngColors(9, 7) = 13
  lngColors(9, 8) = 13
  lngColors(9, 9) = 13
  
  With Target
    If .Column = 4 Or .Column = 5 Then
      If .Count = 1 Then
        varRes = Application.Index(lngColors, Application.Match(Cells(.Row, 4), sngValues, 0), Application.Match(Cells(.Row, 5), sngValues, 0))
        If IsNumeric(varRes) Then
          Cells(.Row, 6).Interior.ColorIndex = varRes
        Else
          Cells(.Row, 6).Interior.ColorIndex = xlNone
        End If
      End If
    End If
  End With
End Sub

' **********************************************************************
' Modul: Tabelle2 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

'Beispiel mit Farbtabelle in der Tabelle

Private Const cstrRangeColors As String = "M3:U11" 'Bereich mit den Farben
Private Const cstrRangeValues As String = "M2:U2" 'Bereich mit den zu Vergleichenden Werten

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim varRes As Variant
  Dim lngRow As Long, lngCol As Long
  
  With Target
    If .Column = 4 Or .Column = 5 Then
      If .Count = 1 Then
        varRes = Application.Match(Cells(.Row, 4), Range(cstrRangeValues), 0)
        If IsNumeric(varRes) Then lngRow = varRes
        varRes = Application.Match(Cells(.Row, 5), Range(cstrRangeValues), 0)
        If IsNumeric(varRes) Then lngCol = varRes
        If lngRow > 0 And lngCol > 0 Then
          Cells(.Row, 6).Interior.ColorIndex = Range(cstrRangeColors).Cells(lngRow, lngCol).Interior.ColorIndex
        Else
          Cells(.Row, 6).Interior.ColorIndex = xlNone
        End If
      End If
    End If
  End With
End Sub

Gruß Sepp

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige