aktive Zelle mit Nebenzellen markieren

Question

Hallo zusammen!

Folgendes Problem bereitet mir Kopfzerverbrechen.
Ich habe in einem Tabellenblatt 3 Listen mit Werten in folgenden Spalten.
Liste 1: (A:F); Liste 2: (H:M); Liste 3: (O:T); also 6 Spalten pro Liste.
Jetzt möchte ich folgendes realisieren. Wenn in einer der Listen eine Zelle
aktiv ist, (z.B. in Liste 1 (B3), dann möchte ich das die Zellen A3:F3 Gelb markiert werden.
Oder (z.B in Liste 2 (H5) dann müssen die Zellen H5:M5 Gelb markiert werden.
Und (z.B. in Liste 3 (P9) dann müssen die Zellen O:T Gelb markiert werden.
Also immer die Zellen vor und hinter der aktiven Zelle innerhalb der Liste.
Ich bin kein Profi und hoffe das ich mich verständlich ausgedrückt habe und bedanke mich
schon mal im vorraus.
Übrigens, ich benutze Excel 2010

Liebe Grüße

Frenzi

Answer 1

Hallo Frenzi,

sind Farben schon vorhanden und müssen erhalten bleiben?
Ist der Einsatz von VBA ok?

Gruß Hajo

Answer 2

Hallo Hajo,

Farben sind nicht vorhanden.
VBA ist ok.

Gruß Frenzi

Answer 3

Hallo Frenzi,

starte den VBA Editor (Alt+F11), Bild sollte zweigeteilt sein ansonsten Strg+R, Doppelklick auf Deine Datei, Doppelklick auf Deine Tabelle, Code ins rechte Fenster kopieren, VBA Editor schließen.
Das Makro wird automatisch gestartet.
Der Code wirkt nur in dieser Tabelle.

Option Explicit ' Variablendefinition erforderlich

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Liste 1: (A:F); Liste 2: (H:M); Liste 3: (O:T)
'***********************************************
'* H. Ziplies *
'* 14.09.14 *
'* erstellt von HajoZiplies@web.de Spam *
'* http://Hajo-Excel.de/ *
'***********************************************
Dim RaBereich As Range ' Variable für Bereich
Dim RaZelle As Range ' Variable für Zelle
Dim dblCount As Double
dblCount = CallByName(Selection, IIf(Val( _
Application.Version) > 11, "CountLarge", "Count"), VbGet)
' von Nepumuk
If dblCount = 1 Then
' nur bei Auswahl einer Zelle
Range("A:F").Interior.ColorIndex = xlNone ' Farbe Löschen
Range("H:M").Interior.ColorIndex = xlNone ' Farbe Löschen
Range("O:T").Interior.ColorIndex = xlNone ' Farbe Löschen
Set RaBereich = Range("A:F") ' Bereich der Wirksamkeit 1. Bereich
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then
'ActiveSheet.Unprotect ("Passwort")
Range(Cells(Target.Row, 1), Cells(Target.Row, 6)).Interior.Color = 65535
'ActiveSheet.protect ("Passwort")
Else
Set RaBereich = Range("H:M") ' Bereich der Wirksamkeit 2. Bereich
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then
'ActiveSheet.Unprotect ("Passwort")
Range(Cells(Target.Row, 8), Cells(Target.Row, 13)).Interior.Color = 65535
'ActiveSheet.protect ("Passwort")
Else
Set RaBereich = Range("O:T") ' Bereich der Wirksamkeit 3. Bereich
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then
'ActiveSheet.Unprotect ("Passwort")
Range(Cells(Target.Row, 15), Cells(Target.Row, 20)).Interior.Color = 65535
'ActiveSheet.protect ("Passwort")
End If
End If
End If
Set RaBereich = Nothing ' Variable leeren
End If
End Sub

Gruß Hajo

Answer 4

Hallo Hajo,

Das ging aber fix. Ich bin sprachlos. Vielen Dank!
Ich probiere es gleich aus und melde mich dann.

Gruß

Frenzi

Answer 5

Hallo Hajo,

es funktioniert SUPER!

Vielen Herzlichen Dank!

Gruß

Frenzi

Answer 6

Hallo Frenzi,

ich hatte schon angefangen mit meiner Annahme und die war ja korrekt.
Danke für die Rückmeldung.

Gruß Hajo

Answer 7

Hi All,

wenn man mit zeitweiser Fehlmarkierung bei Klick zwischen zwei Listen leben kann, gibt's auch noch 'ne kürzere Variante.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Range("A:T").Interior.ColorIndex = xlNone
Target.CurrentRegion.Rows(Target.Row - Target.CurrentRegion.Row + 1).Interior.Color = 65535

End Sub

CurrentRegion sucht dabei die aktuelle Liste rund um die Aktive Zelle von selbst, solange sich keine Leerzeile zwischen der Liste und der aktiven Zelle befindet.

Gruß Mr. K.