Excel VBA - bestimmten Bereich einer Zeile hervorheben ohne das bestehende Format zu

[Quetzalcoatl]

Hallo liebe VBA Profis,
Ich arbeite an einem Excelprojekt und habe mir folgende Aufgabenstellung gestellt:

Ich habe eine Tabelle, in der Zeilenweise viele Daten angezeigt werden. Zur besseren Sichtbarkeit bzw. um nicht in der Zeile zu verrutschen möchte ich, dass ein bestimmter Teil der Zeile farblich hervorgehoben wird, wenn eine Zelle dieser Zeile angeklickt wird.

Folgende Parameter/Vorgaben sollen berücksichtigt werden:
1) Nur im Bereich "B8:AA653" soll es die Möglichkeit geben, per Klick die Zeile zu markieren.
2) Die farbliche Markierung soll nur im Zeilenbereich "E:AA" erscheinen, wobei unterschiedliche Farben zu berücksichtigen wären. Für "E:H" und für "Y:AA" gilt hellblau und für "I:X" gilt mittelblau.
3) Die Markierung darf nicht die ursprüngliche Farb-Formatierung einer Zeile entfernen, nachdem man eine nächste Zeile markiert.
4) Der VBA-Code muss das Tabellenblatt mit unprotect/protect entsperren und wieder sperren.

Ich selber bin schon mit Hilfe diverser teils älterer Beiträge hier aus dem Forum soweit gekommen, dass ich Punkt 3 (mit Hilfe einer zusätzlichen Tabelle) und 4 lösen konnte. Leider verzweifele ich an Punkt 1 und 2. (bisheriger VBA Code siehe unten)

Hat jemand von Euch hierfür eine Hilfestellung bzw. auch einen ganz tollen Lösungsweg, der auch möglicherweise sich komplett von meinem bisherigen und nicht vollständigem Lösungsansatz unterscheidet?

Vielen lieben Dank für Eure Hilfe!!!!
Patrick


So sieht die bisherige Programierung aus:

Code:

[color=#20292a]Private Sub Worksheet_Activate()
ActiveSheet.Unprotect
Application.EnableEvents = True
ActiveSheet.Protect
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False 'Rekursiven Aufruf verhindern
Dim Alt As Long, Neu As Long, Farbe1 As Integer, Farbe2 As Integer, Farbe3 As Integer
Dim Rg As Range

Set Rg = Range.Cells(Target.Row, Target.Column)
Farbe1 = 42
Farbe3 = 42
Farbe2 = 42
Neu = Target.Row
'Alte Zeile identifizieren
Alt = Sheets("Tabelle1").Cells(1, 1).Value
If Alt < 1 Then GoTo Skipit 'Es gibt noch keine Sicherung
'Alte Zeile wiederherstellen
Sheets("Tabelle1").Rows(Alt).Copy
Sheets("TP 304L").Rows(Alt).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Skipit:
'Jetzt die Formatierung (und nur die) der aktiven Zeile kopieren
Rows(Neu).Copy
Sheets("Tabelle1").Rows(Neu).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Tabelle1").Cells(1, 1) = Target.Row 'Zeilennummer sichern
With Rows(Neu)
'Diese Abfrage bewirkt, dass die Zeile in Farbe2 gefärbt wird, wenn
'die gewählte Zelle bereits die Farbe1 hat:
If .Interior.ColorIndex = Farbe1 Then
.Interior.ColorIndex = Farbe2
Else
.Interior.ColorIndex = Farbe1
End If
End With
'Diese Abfrage bewirkt, dass die ZELLE in Farbe2 gefärbt wird, wenn
'die gewählte Zelle bereits die Farbe3 hat:
With Cells(Neu, Target.Column)
If .Interior.ColorIndex = Farbe3 Then
.Interior.ColorIndex = Farbe2
Else
.Interior.ColorIndex = Farbe3
End If
End With
Rg.Activate
Application.EnableEvents = True
ActiveSheet.Protect
End Sub[/color]

https://forum.chip.de/discussion/1891800...u-loeschen

[schauan]

Hallöchen,

erst mal zu erstens. Das kannst Du über den Schutz einstellen, indem Du nur ungesperrte Zellen wählbar stellst. Der Bereich ist doch ungesperrt?
Ansonsten müsstest Du im VBA-Code im SelectionChangeEreignis die Adresse der angeklickten Zelle(n) prüfen und bei "falschem" Target irgendwohin in den definierten Bereich zurückspringen.

[RPP63]

Moin!
Wenn Du eine bedingte Formatierung nutzt, hältst Du den Code extrem schlank und brauchst Dich nicht um Zellenformate kümmern.

• Bereich markieren, bedingte Formatierung, neue Regel, Formel zur Ermittlung …
  
• Formel ist: =ZEILE()=AktiveZeile
  

Microsoft Excel Objekt Tabelle3

Option Explicit 



Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

With ThisWorkbook 

  If Not Intersect(Target, Range("B18:J33")) Is Nothing Then 

    .Names.Add Name:="AktiveZeile", RefersToR1C1:=Target.Row 

  Else 

    On Error Resume Next 

    .Names("AktiveZeile").Delete 

    On Error GoTo 0 

  End If 

End With 

End Sub 

Datei im Anhang.

Gruß Ralf

[Kuwer]

Hi Ralf,

das ist wirklich genial einfach. :28:
Hast Du das irgendwo schon mal gesehen oder Dir gerade "ausgedacht"?

Gruß Uwe

[RPP63]

Moin Uwe!

Ich habe mir das Prinzip von einem User in einem anderen Forum abgeschaut, der nicht mehr aktiv ist (den Nickname habe ich leider vergessen).
War auch bei mir ein Aha-Erlebnis, so dass ich dies sofort in meine "Fadenkreuz-Datei" eingebaut habe.

Ich stelle die gleich mal zur Verfügung, weil sie verschiedene Varianten beinhaltet.

Gruß Ralf

[Quetzalcoatl]

Hallo,

in einem anderen Forum hat ein sehr schlauer Zeitgenosse (Name = Holger alias echo) mir einen Lösungsvorschlag unterbreitet, den ich in diesem Forum dann auch mal vorstellen will, weil er so genial einfach gestaltet ist.

In das Code-Fenster des Tabellenblattes wir folgender VBA-Code eingefügt:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.Unprotect
    Range("ac1").Value = ActiveCell.Row 'Zeilennummer wird in Zelle "AC1" geschrieben
ActiveSheet.Protect
End Sub

Dann markiert man den gewünschten Bereich der Tabelle in der die Zeilen markiert werden sollen (zB. E6:AA536) und fügt in der bedingten Formatierung folgende Formel ein:

=ZEILE(E6)=$AC$1

Dann noch das entsprechende Format auswählen, fertig!

Das Ganze ließe sich auch entsprechend mit ActiveCell.Column/Spalte für ein Fadenkreuz erweitern.

Die Zelle ("AC1"), die das Ergebnis des VBA-Codes auswirft, kann man beliebig wählen, wo auch Platz auf dem Tabellenblatt ist.

Wer sein Tabellenblatt nicht geschützt hat, kann "ActiveSheet.Unprotect bzw. Protect" dann natürlich weglassen.

Für mich die perfekte Lösung!

Grüße Patrick

[RPP63]

Moin!
Ja, Holgers Code ist auch bestechend einfach!
Allerdings wird die Zeile/Spalte im Bereich auch markiert, wenn sich die markierte Zelle außerhalb des Bereichs befindet.
Daher muss der Code ein wenig erweitert werden.
Hier mal für meine erste hochgeladene Datei CEF_Zeile_bedFor (dann gleich als Fadenkreuz):


Bereich B18:J33 markieren, bedingte Formatierung, neue Regel, Formel zur Ermittlung … (zwei mal!)
Formel 1 ist: =SPALTE(B18)=$J$2
Formel 2 ist: =ZEILE(B18)=$I$2

Im Modul dieser Tabelle:

PHP-Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("B18:J33")) Is Nothing Then
  Range("I2") = Target.Row
  Range("J2") = Target.Column
Else
  Range("I2,J2").ClearContents
End If
End Sub 


Wandert auf jeden Fall in meine Sammlung!

Und als Ergänzung:
ActiveSheet und ActiveCell haben in Deinem Ereignismakro nichts zu suchen:
ActiveSheet = Me (bei mir allerdings überflüssig)
ActiveCell = Target

[Quetzalcoatl]

Hallo Ralf,

was hat es denn auf sich mit ActiveSheet/Cell, dass es nichts im Makro zu suchen hat? 

Welcher Nachteil entsteht?

[RPP63]

Es gibt keine direkten Nachteile, sondern mir geht es um korrekte Benennung der Objekte.
Target wird Dir bereits als Übergabeparameter des Ereignis-Makros vorgegeben:

PHP-Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 


In diesem Makro ist per Definition das Parent Me und nicht ActiveSheet (auch, wenn beides funktioniert).

Vielleicht kennst Du es von einem Userform:
Es funktioniert zum Schließen: Unload UserForm1
"Richtiger" ist jedoch Unload Me

[Kuwer]

Hallo,

ActiveCell muss nicht mit Target identisch sein, wenn man das Markieren eines Bereiches nicht oben links beginnt.

Gruß Uwe