mit Doppelklick kopieren

Hallo allerseits,
ich benötige etwas Hilfe bei der Doppelklick-Funktion:
Bisher nutze ich folgenden Code, um aus einer Liste einen Inhalt in eine bestimmte Zelle zu kopieren, wo dann automatisch eine weitere Aktion ausgelöst wird. Das klappt auch wunderbar:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Zelle liegt im Bereich ab Zeile 13 und in Spalte 2
If Target.Row > 12 Then
If Target.Column = 2 Then
If Not IsEmpty(Target.Value) Then _
'  mit Doppelklick wird Zeile 3 in Spalte 2 (B3) gefüllt
Cells(3, 2).Value = Target.Value
Cancel = True
End If
End If
If Target.Column = 3 Then
If Not IsEmpty(Target.Value) Then _
'  mit Doppelklick wird Zeile 3 in Spalte 3 (C3) gefüllt
Cells(3, 3).Value = Target.Value
Cancel = True
End If
End If
If Target.Column = 4 Then
If Not IsEmpty(Target.Value) Then _
'  mit Doppelklick wird Zeile 3 in Spalte 4 (D3) gefüllt
Cells(3, 4).Value = Target.Value
Cancel = True
End If
End If
If Target.Column = 5 Then
If Not IsEmpty(Target.Value) Then _
'  mit Doppelklick wird Zeile 3 in Spalte 5 (E3) gefüllt
Cells(3, 5).Value = Target.Value
Cancel = True
End If
End If
If Target.Column = 6 Then
If Not IsEmpty(Target.Value) Then _
'  mit Doppelklick wird Zeile 3 in Spalte 6 (F3) gefüllt
Cells(3, 6).Value = Target.Value
Cancel = True
End If
End If
End If
End Sub

Jeder Doppelklick, z. B. beim letzten Teil auf Zelle X in Spalte 6 kopiert somit den jeweils ausgewählten Wert unabhängig von den anderen in Zelle F3.
Das ist auch sinnvoll, weil diese Abfolge hierarchisch aufgebaut ist und bei Spalte 4 (z. B. Werkzeug) Excel ja nicht weiß, ob in Spalte 6 Zange oder Hammer gesucht wird.
Wenn allerdings in Spalte 6 der Hammer ausgewählt wird, sollen die Inhalte aus derselben Zeile in Spalte 5 (z.B. Handwerkzeug) in E3 und gleichzeitig aus Spalte 4 (z. B. Werkzeug allgemein) in D3 usw. kopiert werden.
Ich habe für eine solche Aufgabenstellung kein Beispiel und damit auch keine Lösung finden können, aber vielleicht hat ja hier mal wieder jemand eine wunderbare Lösung?
Beste Grüße aus dem Nordwesten, wo es endlich mal etwas regnet! (Hätte nie gedacht, dass ich mich mal über Regen freuen würde!)
Reinhard

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo mmat,
das beruhigt mich,ich fing schon anzu zweifeln, ob wirklich alles richtig übertragen wurde :-)
Umso besser, dass es doch funktioniert.
"Hammer ausgewählt" soll heißen, dass diese Funktion ausgelöst wird
If Target.Column = 6 Then
If Not IsEmpty(Target.Value) Then _
' mit Doppelklick wird Zeile 3 in Spalte 6 (F3) gefüllt
Cells(3, 6).Value = Target.Value
Cancel = True
End If
End If
und per Doppelklick "Hammer" in die Zelle F3 kopiert wird. Die daraufhin ausgelöste Aktion zeigt dann eine Tabelle mit allen verfügbaren Hämmern, woraus wiederum andere Auswertungen erzeugt werden.
Ein Doppelklick auf Werkzeug in Spalte 4 würde dasselbe machen und Werkzeug in Zelle D3 kopieren, und eine Tabelle mit allen Werkzeugen anzeigen.
Alles unabhängig voneinander, so war es auch gewollt. Für eine Erweiterung soll jetzt aber mit dem Doppelklick auf die unterste Ebene, also hier Hammer, auch der in derselben Tabelle stehende Werte der Spalten 1-5 gleichzeitig in A3 bis E3 kopiert werden, also sozusagen eine Rückwärts-Abhängigkeit erzeugt werden und alle Tabellen gleichzeitig mit dieser Auswahl aktualisiert werden.
Also Doppelklick z. B. auf Zeile 15 in Spalte 1 kopiert Wert aus Zelle A15 in A3, Doppelklick in Zeile 15 in Spalte 2 kopiert Wert aus B15 in B3 und gleichzeitig A15 in A3.
Doppelklick auf Zeile 15 in Spalte 3 kopiert Wert aus Zelle C15 in C3 und gleichzeitig B15 in B3 und A15 in A3.
Ich weiß nicht, wie ich es sonst erklären soll?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim c As Long, r As Long 'Zelle liegt im Bereich ab Zeile 13 und in Spalte 2 If Target.Row 6 Then Exit Sub 'leere Zelle ? Tschö! If IsEmpty(Target.Value) Then Exit Sub c = Target.Column r = Target.Row Range(Cells(3, 1), Cells(3, 6)).ClearContents Range(Cells(r, 1), Cells(r, c)).Copy Cells(3, 1) Cancel = True End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread