Worksheet_Change: Zurücksetzung der Veränderungen wenn alter Wert wieder gilt

[JonasRe]

Hallo zusammen,

ich habe eine Tabelle, in der die Zellen in den Spalten T bis Z, sowie in der Spalte P, bei Veränderung des Wertes farblich markiert werden. Nun will ich jedoch den ursprünglichen Wert zwischenspeichern, da sobald der alte Wert wieder eingegeben wird, die Zelle wieder entfärbt werden soll. Es geht dabei um eine Tabelle, deren Werte eingelesen werden. Zu Beginn stehen in den Spalten P und T-Z die identischen Werte wie in den Spalten AJ und AN-AS, da die linke Seite die zukünftigen Daten repräsentieren sollen (sprich dort werden Veränderungen vorgenommen) und auf der rechten Seite die aktuellen Daten. Dabei müsste es doch bestimmt eine Möglichkeit geben, durch vergleich der Zellenwerte festzustellen, ob der alte Wert wieder vorhanden ist, oder?

Sprich, wenn in Zelle T3 ursprünglich ein A steht und dann zu einem B geändert wird verfärbt sich die Zelle gelb. Wird nun das B wieder in A geändert, soll die Zelle wieder standardmäßig weiß sein.

Code:

Sub Worksheet_Change(ByVal Target As Range)


If Not Intersect(Target, Range("T3:Z3000,P3:P3000")) Is Nothing Then

   Target.Interior.ColorIndex = 6


End If

End Sub

Bin über jede Hilfe dankbar :)

[schauan]

Hallöchen,

eventuell kopierst Du gleich mal die ursprünglichen Daten und vergleichst nach der Änderung mit dem neuen Eintrag. Immerhin könnte der ja auch gleich dem alten sein, dann wäre die Färbung umsonst
Im Prinzip

If ZelleMitAltenDaten.Value = Target.Value Then KeineFarbe Else Target.Interior.ColorIndex = 6

[JonasRe]

Hallo schauan,

vielen Dank erst mal. Wie genau bekomme ich denn den zellenweisen Vergleich hin zwischen den Spalten untereinander. Mache ich das mit einer Range und ich durchlaufe alle Zellen, oder mit einem Array?

Könntest du mir bitte eine Hilfestellung geben?

Danke und Grüße
Jonas

[Steffl]

Hallo Jonas,

wieso willst Du einen ganzen Bereich überprüfen, wenn Du nur zellenweise was änderst?

[Kuwer]

Hallo Jonas,

teste es mal so:

Sub Worksheet_Change(ByVal Target As Range)
  Dim rngArea As Range, rngBereich As Range, rngZelle As Range
  Set rngBereich = Intersect(Target, Range("P3:P3000,T3:Z3000"))
  If Not rngBereich Is Nothing Then
    For Each rngArea In rngBereich.Areas
      For Each rngZelle In rngArea
        If rngZelle.Value <> rngZelle.Offset(0, 16).Value Then
          rngZelle.Interior.ColorIndex = 6
        Else
          rngZelle.Interior.ColorIndex = xlColorIndexNone
        End If
      Next rngZelle
    Next rngArea
  End If
End Sub

Gruß Uwe

[JonasRe]

@Steffl, ich habe mich unklar ausgedrückt. Ich will Zellen in einem definierten Bereich überprüfen. Sprich ich müsste ja erst den Bereich definieren, für den die Zellen explizit geprüft werden sollen. Aber die Lösung mit Offset von Kuwer sieht nach dem aus, was ich gebrauchen könnte.

@Kuwer, vielen Dank schon mal. Ich werde deinen Code prüfen und Feedback geben :)

[JonasRe]

@Kuwer, beim Testen funktioniert alles soweit wie ich es wollte. Du hast mir enorm weitergeholfen. Ich habe nur eine Sache verändert, den Offset von 16 auf 20, da die Spalten von P auf AJ und die Spalten von T-Z auf AN-AS um 20 Spalten verschoben sind. Vielen Dank :)

[Kuwer]

Ich habe nur eine Sache verändert, den Offset von 16 auf 20, da die Spalten von P auf AJ und die Spalten von T-Z auf AN-AS um 20 Spalten verschoben sind

 :19: