VBA: Wert per Klick bzw. Doppelklick an Autofilter übergeben [PflebIT

Diese Seite ist nicht editierbar. Sie können den Quelltext sehen, jedoch nicht verändern. Kontaktieren Sie den Administrator, wenn Sie glauben, dass hier ein Fehler vorliegt.

====== VBA: Wert per Klick bzw. Doppelklick an Autofilter übergeben ======

__Problem:__

  * In Tabellenblatt "Tabelle1" steht in Spalte A in jeder Zeile eine Identifikationsnummer (also eine Zahl).
  * Diese Zahl soll per einfachem Klick bzw. per Doppelklick auf das jeweilige Feld an ein fest vorgegebenes Feld (A2) auf das Tabellenblatt "Tabelle3" übergeben werden.
  * In Tabellenblatt "Tabelle2" ist eine Liste enthalten, die mehrere Einträge zur gleichen Identifikationsnummer der Tabelle1 enthält (also eine Untertabelle).
  * Wenn nun der Benutzer in Tabelle1 einen Doppelklick auf eine Zelle der Spalte A ausführt, wird die jeweilige Identifikationsnummer zuerst nach Tabelle2 in das Feld A2 kopiert. Anschließend wird dieser Wert verwendet, um in Tabelle2 alle Einträge zu filtern, die in Spalte A diesen Wert enthalten.
  * Voraussetzung: Lassen Sie sich beide Tabellenfenster gleichzeitig anzeigen (Tabellenblatt "Tabelle1" auf Bildschirm 1 und Tabellenblatt "Tabelle2" auf Bildschirm 2).
  * Eine Mustertabelle dazu finden Sie hier: [[kb:w:excel-wiedervorlage-mit-makro-untertabelle|]]



__Lösung für einfachen Klick:__

In Tabelle1 wird folgender VBA-Code hinterlegt:

<code>

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
  If Target.Column = 1 Then
     Tabelle3.Range("A2").Value = Target.Value
     Target.Copy
  End If

'Alternative Variante mit Doppelklick
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
  ' Tabelle3.Range("A2").Value = Target.Value
  ' Target.Copy
  ' Cancel = True

  If Tabelle2.AutoFilterMode Then
     Tabelle2.AutoFilterMode = False
  End If
  
  If Not ActiveSheet.AutoFilterMode Then
     Tabelle2.Range("A1").AutoFilter
     Tabelle2.Range("A1").AutoFilter 1, Tabelle3.Range("A2").Value
  End If


End Sub

</code>