Markierte Zellen & Ergebnisse anzeigen

[Solevita]

Hallo zusammen,

ich benötige Hilfe bei meiner Tabelle. Es gibt mehrere Dinge die ich gern umsetzen würde. Betroffene Tabelle ist im Anhang.



Es handelt sich hierbei um Kombinationsmöglichkeiten zwischen Tellerlängen (Zeile 2 > B2:T2) und Schraubenlängen (A3:A20). Wenn ich auf eine Zahl innerhalb der Tabelle (B3:U20) klicke, möchte ich, dass die Zellen mit der Schraubenlänge links und der Tellerlänge oben farblich markiert werden. Nicht die gesamte Zeile oder Spalte, nur die beiden Zellen. Habe Anleitungen gefunden die mir die ganze Zeile markiert aber nicht ausschließlich die beiden jeweiligen Zellen.
Beispiel: Ich klicke auf D6, A6 und D2 werden farblich markiert. Ich klicke auf E6, A6 und D2 werden ebenfalls farblich markiert usw.

Im nächsten Step stelle ich mir vor bei X3 einen Wert aus der Tabelle (B3:U20) einzutragen und Excel gibt mir eine Zeile darunter alle Kombinationsmöglichkeiten als Ergebnis.
Beispiel: Ich schreibe unter "Stahl UK" 100. Das Ergebnis müsste dann lauten: 15/110; 35/90; 55/70 (alle 3 Kombinationsmöglichkeiten).

Ich weiß nicht wie aufwändig das ganze ist, würde mich aber sehr über Hilfe freuen.

[PetrolMaxxe]

Hallo,
Teste mal.

  schrauben-teller.xlsm (Größe: 20,93 KB / Downloads: 3)

Gruß Uwe

[Solevita]

Hallo Uwe,

vielen Dank! Die Markierung springt allerdings nur um, wenn ich auf die geraden (blauen) Spalten klicke. Kann man es so einstellen, dass es auch auf den ungeraden Spalten passiert?

Das die angeklickten Werte in Zelle 24 bzw. 25 angezeigt werden ist allerdings nicht nötig, da ich dort händische Einträge vornehmen möchte.
Ich habe daher die letzten beiden Kommandos raus genommen. Trotzdem Danke für die Idee. :-)

[PetrolMaxxe]

ja, das ist überhaupt kein Problem und überaus einfach. 
Ich nahm an, dass du es selbst erkennnst und ensprechend erweiterst.

ins Modul des Tabellenblattes - dann so:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("rng_1")) Is Nothing Then
        Rows(2).Interior.Color = xlNone
        Columns(1).Interior.Color = xlNone
        Cells(2, Target.Column).Interior.Color = vbYellow
        Cells(Target.Row, 1).Interior.Color = vbYellow
        Cells(3, 24) = Target.Cells
        Cells(3, 25) = Target.Cells.Offset(0, 1)
    End If
    If Not Intersect(Target, Range("rng_2")) Is Nothing Then
        Rows(2).Interior.Color = xlNone
        Columns(1).Interior.Color = xlNone
        Cells(2, Target.Column - 1).Interior.Color = vbYellow
        Cells(Target.Row, 1).Interior.Color = vbYellow
        Cells(3, 24) = Target.Cells.Offset(0, -1)
        Cells(3, 25) = Target.Cells
    End If
End Sub

Den 2. Range ("rng_2") legst du durch Markieren und Benennen an. Anleitung dazu gibt es jede Menge im Netz.
Gruß Uwe

[Solevita]

Hallo Uwe,

ich wusste nicht wie man die Range festlegt, danke das schaue ich mir mal an. Jetzt aber kommt eine Fehlermeldung.

"Laufzeitfehler '1004': Die Methode 'Range' für das Objekt '_Worksheet' ist fehlgeschlagen"

Er markiert mir folgende Zeile: If Not Intersect(Target, Range("rng_2")) Is Nothing Then

[PetrolMaxxe]

wie man einen Range anlegt so:
   

Gruß Uwe

[Solevita]

Ich habe es nun hinbekommen, dass in allen Zellen die ich anklicke, die erste Spalten richtig markiert werden. Allerdings funktioniert die Markierung oben in Zeile 2 nach wie vor nur in den blauen Spalten.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng_1 As Range
    Set rng_1 = Range("B3:U20")

    If Not Intersect(Target, rng_1) Is Nothing Then
        Rows(2).Interior.Color = xlNone
        Columns(1).Interior.Color = xlNone
        Cells(2, Target.Column).Interior.Color = vbYellow
        Cells(Target.Row, 1).Interior.Color = vbYellow
    End If
End Sub


Was mache ich falsch? Ich habe doch als Range die gesamte Tabelle angegeben. Von B3 bis U20.

[Solevita]

Chat GPT hat mir folgenden Code empfohlen aber auch der funktioniert nicht:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng_1 As Range
Set rng_1 = Range("B3:U20")

If Not Intersect(Target, rng_1) Is Nothing Then
Rows(2).Interior.Color = xlNone
Columns(1).Interior.Color = xlNone
Range(Cells(2, Target.Column), Cells(2, Target.Column)).Interior.Color = vbYellow
Cells(Target.Row, 1).Interior.Color = vbYellow
End If
End Sub

[PetrolMaxxe]

Hallo,
 
ChatGPT liefert meist nur Mist. 
Wir selbst haben graue Zellen zum Lesen - Nachdenken - Nachvollziehen. 
Das gründlich eingesetzt wird stets ein funktionierendes Ergebnis erzeugen.
Da das Bild was ich dir hochgeladen hatte so nicht weitergeholfen hat, gehe wie folgt vor.
Gehe im Ribbonband von Excel auf Daten --> Namensmanager --> Neu.
 
Dann trage im Feld "Name:" rng_2 ein und im Feld "Bezieht sich auf:" die Formel:

Code:

=Tabelle1!$C$3:$C$20;Tabelle1!$E$3:$E$20;Tabelle1!$G$3:$G$20;Tabelle1!$I$3:$I$20;Tabelle1!$K$3:$K$20;Tabelle1!$M$3:$M$20;Tabelle1!$O$3:$O$20;Tabelle1!$Q$3:$Q$20;Tabelle1!$S$3:$S$20;Tabelle1!$U$3:$U$20

ein. 
Schließe das Fenster des Namensmager.
 
Gehe zum Namensfeld links oben und klicke rein. Da stehen die beiden Ranges drin. Diese jeweils Anklicken und es werden die relevanten Bereiche in der Tabelle markiert.
Statt diese Formel einzugeben bekommt es viel einfacher händisch, so wie im Bild gezeigt mit Benennung im Namensfeld hin.
Sind beide Ranges vorhanden wird auch diese Prozedur sauber funktionieren.
 
Gruß Uwe

[Solevita]

Hallo Uwe, danke für die Anleitung. Warum muss ich es denn unbedingt in 2 Ranges aufteilen? Ich habe die Formel jetzt nur "rng" genannt und dafür alle Spalten hinterlegt.

Code:

=Tabelle1!$B$3:$B$20;Tabelle1!$C$3:$C$20;Tabelle1!$D$3:$D$20;Tabelle1!$E$3:$E$20;Tabelle1!$F$3:$F$20;Tabelle1!$G$3:$G$20;Tabelle1!$H$3:$H$20;Tabelle1!$I$3:$I$20;Tabelle1!$J$3:$J$20;Tabelle1!$K$3:$K$20;Tabelle1!$L$3:$L$20;Tabelle1!$M$3:$M$20;Tabelle1!$N$3:$N$20;Tabelle1!$O$3:$O$20;Tabelle1!$P$3:$P$20;Tabelle1!$Q$3:$Q$20;Tabelle1!$R$3:$R$20;Tabelle1!$S$3:$S$20;Tabelle1!$T$3:$T$20;Tabelle1!$U$3:$U$20

Dann habe ich den Code wie folgt angepasst:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("rng")) Is Nothing Then
        Rows(2).Interior.Color = xlNone
        Columns(1).Interior.Color = xlNone
        Cells(2, Target.Column).Interior.Color = vbYellow
        Cells(Target.Row, 1).Interior.Color = vbYellow
    End If
End Sub

Allerdings natürlich erfolglos. Ich hatte echt gedacht das ist schnell gemacht und der nächste Schritt wäre kompliziert aber ...