Zellfarbe ändern

Question

Guten Abend an alle Helfer,

ich möchte, dass sich die Zellfarbe ändert, wenn sich der Wert heute ändert oder wenn auch, wenn sich der Wert heute um 1 erhöht.
Beispiel:
gestern: A1 = 1
heute: A1 = 2 (nur heute soll sich sich zellfarbe ändern).

Eine Lösung mit einer bedingten Formatierung wäre meine Idee, nur fehlt mir die richtige Formel.

MfG

Offi

Answer 1

Hallo,

so dürfte es funktionieren:

Funktion:
- Beim Speichern wird der aktuelle Wert aus Zelle A1 in Tabelle 1 in Zelle A1 der Tabelle 2 gespeichert/gemerkt.
- Beim Öffnen der Datei wird der Hintergrund der Zelle A1 in Tabelle 1 zurückgesetz
- Wird der Wert in A1 in Tabelle 1 geändert, wird der Wert mit dem gemerkten Wert verglichen. Sind die beiden Werte unterschiedlich, wird die Zelle gelb hinterlegt.


Das Makro läuft unter Excel 2007, in früheren Versionen muss man die Formatierung anderst machen.

' Diese beiden subs in "DieseArbeitsmappe"

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Vor dem Speichern den aktuellen Wert merken
ThisWorkbook.Worksheets("Tabelle2").Cells(1, 1).Value = ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1)
End Sub

Private Sub Workbook_Open()
' beim Öffnen die Hintergrundfarbe der Zelle entfernen
ThisWorkbook.Worksheets("Tabelle2").Cells(1, 1).Value = ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1)
With ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1).Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
[code]


[code]
' Dieses sub in "Tabelle1"
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A1") Then

Dim dWertGemerkt As Double

' Gemerkten Wert aus Tabelle 2 lesen
datDatumGemerkt = ThisWorkbook.Worksheets("Tabelle2").Cells(1, 1).Value ' Zelle A1


If dWertGemerkt <> ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1) Then
With ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
End Sub

[k] Alle Angaben wie immer ohne Gewähr :-) [/k]

Gruß Jürgen

Answer 2

...verschachtelte Formatierungen gehen wohl nicht..

hier nochmal die "Reinform"

' Diese beiden subs in "DieseArbeitsmappe"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Vor dem Speichern den aktuellen Wert merken
ThisWorkbook.Worksheets("Tabelle2").Cells(1, 1).Value = ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1)
End Sub

Private Sub Workbook_Open()
' beim Öffnen die Hintergrundfarbe der Zelle entfernen
ThisWorkbook.Worksheets("Tabelle2").Cells(1, 1).Value = ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1)
With ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1).Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

' Dieses sub in "Tabelle1"
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A1") Then

Dim dWertGemerkt As Double

' Gemerkten Wert aus Tabelle 2 lesen
datDatumGemerkt = ThisWorkbook.Worksheets("Tabelle2").Cells(1, 1).Value ' Zelle A1


If dWertGemerkt <> ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1) Then
With ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
End Sub

Answer 3

Bedingte Formatierung ist schon richtig. Wenn ich die Frage richtig vestehe:
a1>1
In dem kleinen Dropdown-Auswahlfenster muss Formel ist ausgewählt werden.

Alternativ in dem kleinen Dropdown-Auswahlfeld Zellwert ist auswählen, in dem zweiten Dropdown-Auswahlfeld die Bedingung auswählen, im letzen Feld dann den nur Grenzwert eintragen.

Das müsste eigentlich reichen. Kann das hier nur mit OpenOfficeCalc testen, ich denke aber, dass das unter Excel auch so funktioniert.

Answer 4

Shit:
[*]Frage falsch verstanden
[*]zu spät[/list]

Answer 5

Hallo MasterOfHardness, trotzdem danke für den Versuch.

Hallo Jürgen, da ich von Makros keine Ahnung habe brauche ich noch ein bißchen mehr Hilfe. Ich habe zwei Tabellenblätter und möchte die Zelländerungen gern im Tabelleblatt "Auswertungen" vornehmen. Wohin muss ich dieses Makro kopieren?

MfG

Offi

Answer 6

Hallo Offi,

sag mir bitte noch, welche Zelle Du überwachen möchtest und wie das zweite Tabellenblatt heißt (nur damit es keine Kollosionen gibt).
Dann passe ich den Code an und sage Dir, wie man ihn einbindet.

Gruß
Jürgen

Answer 7

Hallo Jürgen,

im Tabellenblatt "Auswertungen" sind es die Zellen J 7 bis M 18.
Das zweite Tabellenblatt (es ist vollkommen leer) heißt "Tabelle 1".

Ich hoffe, die Angaben helfen Dir (mir?).

Gruß
Offi

Answer 8

Hallo Offi,

mit ALT+F11 kommst Du in den Visual Basic Editor.
Dort müsstest Du links ein Fenster mit VBAProjekt(DeinDateiName) finden.

Öffne den Ordnerbaum unter "Microsoft Excel Objekte"

Doppelklick auf "DieseArbeitsmappe"

Nun kopierst Du in das rechte Fenster diesen Code:

' Dieses sub in "DieseArbeitsmappe"
Private Sub Workbook_Open()

Dim iZaehler As Integer
Dim oWSTemp As Worksheet
Dim oWSAuswertung As Worksheet
Dim oWSMerker As Worksheet
Dim bGefunden As Boolean

Application.ScreenUpdating = False

Set oWSAuswertung = ThisWorkbook.Worksheets("Auswertungen")

' Prüfen, ob das "Merker"-worksheet existiert, ggf. einfügen
bGefunden = False
For Each oWSTemp In ThisWorkbook.Worksheets
If oWSTemp.Name = "DASISTDASMERKERWORKSHEET" Then bGefunden = True
Next

If bGefunden = False Then
Set oWSMerker = ThisWorkbook.Worksheets.Add
oWSMerker.Name = "DASISTDASMERKERWORKSHEET"
Else
Set oWSMerker = ThisWorkbook.Worksheets("DASISTDASMERKERWORKSHEET")
End If

oWSMerker.Visible = xlSheetVisible
' Inhalte aus dem gewünschten Bereich in das "Merker" Worksheet kopieren
oWSAuswertung.Activate
oWSAuswertung.Range(Cells(7, 10), Cells(18, 13)).Copy
oWSMerker.Activate
oWSMerker.Range(Cells(7, 10), Cells(18, 10)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
oWSMerker.Visible = xlSheetHidden

' Hintergrundfarbe der Zelle entfernen
oWSAuswertung.Activate
With oWSAuswertung.Range(Cells(7, 10), Cells(18, 13)).Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

oWSAuswertung.Cells(1, 1).Select

Application.ScreenUpdating = True

End Sub

Das gleiche machst Du mit (vermutlich)
Tabelle1(Auswertungen) und diesem Code:

' Diesen Code in "Auswertung"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oWSTemp As Worksheet
Dim oWSAuswertung As Worksheet
Dim oWSMerker As Worksheet
Dim bGefunden As Boolean
Dim lAktiveZeile As Long
Dim iAktiveSpalte As Integer

lAktiveZeile = Target.Cells(1).Row
iAktiveSpalte = Target.Cells(1).Column

If lAktiveZeile >= 7 And lAktiveZeile <= 18 And iAktiveSpalte >= 10 And iAktiveSpalte <= 13 Then

Application.ScreenUpdating = False

Set oWSAuswertung = ThisWorkbook.Worksheets("Auswertungen")

' Prüfen, ob das "Merker"-worksheet existiert, ggf. einfügen
bGefunden = False
For Each oWSTemp In ThisWorkbook.Worksheets
If oWSTemp.Name = "DASISTDASMERKERWORKSHEET" Then bGefunden = True
Next

If bGefunden = False Then
Set oWSMerker = ThisWorkbook.Worksheets.Add
oWSMerker.Name = "DASISTDASMERKERWORKSHEET"
Else
Set oWSMerker = ThisWorkbook.Worksheets("DASISTDASMERKERWORKSHEET")
End If

oWSMerker.Visible = xlSheetHidden

If oWSAuswertung.Cells(lAktiveZeile, iAktiveSpalte).Value <> oWSMerker.Cells(lAktiveZeile, iAktiveSpalte).Value Then
With oWSAuswertung.Cells(lAktiveZeile, iAktiveSpalte).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If

Application.ScreenUpdating = True

End If
End Sub

Mit Excel 2007 sollte das nun laufen.

Gruß
Jürgen



Alle Angaben wie immer ohne Gewähr :-)

Answer 9

P.S. Makros müssen natürlich aktiviert sein

Die Datei sollte in einem Ordner der "vertrauenswürdigen Speicherorte" liegen.

Excel Optionen --> Vertrauensstellungscenter --> Einstellungen für das Vertrauensstellungscenter --> vertrauenswürdige Speicherorte

P.S. Ich muss mich durch dieses Excel 2007 erst einmal durchkämpfen, aber selbst mit gutem Willen finde ich das Teil absolut unübersichtlich ..

Answer 10

Hallo miteinander,

wenn ich die Frage richtig verstehe soll im Bereich J7:M18 die Zelle mit dem aktuellen Datum farblich markiert werden.

Wenn das so ist, braucht man dazu kein riesiges Makro sondern nur die Bedingte Formatierung.

@Offi

gehe wie folgt vor

- markiere den Bereich J7:M18
- rufe die Bedingte Formatierung auf
- Formel ist: J7=HEUTE()
- wähle ein Format und bestätige mit OK

Im genannten Bereich wird nun das aktuelle Datum eingefärbt, egal wo es steht.

Gruß
Rainer