VBA anpassen für unterschiedliche Zellen

Lehrbub

Grünschnabel
Hallo,

ich möchte mein VBA Code ein wenig anpassen.
Die Tabelle auf die sich meine Frage bezieht ist mit hochgeladen (allerdings ohne Makros..)

Momentan passiert nach dem Doppelklick auf Zelle 3, dass das sheet2 "Materialliste" geöffnet wird, es wird nach dem Wort aus Zelle 3 gefiltert, und ich springe im sheet 2 in die letzte Zeile (ohne Wert) in Zelle 2.

Nun möchte ich, dass so bleibt, aber zusätzlich, wenn ich in Zelle 4 doppelklicke (wo die Symbole sind), soll auch nach dem Wert aus Zelle 3 in sheet 2 gefiltert wird. Es soll zusätzlich auch der Wert aus Zelle 3 mit kopiert wird, wenn ich in die unterste leere Zeile im anderen Sheet 2 springe . Der Wert soll sich dabei in die Zelle 4 (Typ) kopieren.

Wie kann ich das anstellen?

Der Code in VBA lautet:

Visual Basic:
Option Explicit


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strCellVal As String
Dim i As Long

    On Error Resume Next
  
    If Intersect(Target.EntireRow, [Übersicht[Typ]]) Is Nothing Then Exit Sub
    If Target.Column <> 3 Then Exit Sub
  
    strCellVal = ActiveCell.Value
  
  
    With Sheet2
        .ListObjects(1).Range.AutoFilter 2, Criteria1:=Intersect(Target.EntireRow, [Übersicht[Typ]])
        .Activate
        i = .ListObjects(1).Range.Columns(1).SpecialCells(xlCellTypeVisible).Count
     If i = 1 Then
        .ListObjects(1).Range.End(xlDown).Offset(1, 2).Value = strCellVal
     End If
        .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row + 1, 2).Select
      
    End With
      
    Cancel = True

End Sub




Danke!
 

Anhänge

  • Probe_.xlsx
    22,4 KB · Aufrufe: 4
Zuletzt bearbeitet von einem Moderator:
1) Bitte in Zukunft deinen Code in Code-Tags setzen. Ich habe das mal für dich gemacht.
2) Mit Zelle meinst du wahrscheinlich Spalte. Denn eine Zelle besteht IMMER aus den Koordinaten von Zeile und Spalte.
3) Arbeite nur im Notfall mit ActiveCell. Du hast das Objekt Target zur Verfügung um herauszufinden was angeklickt wurde.
Zum Thema

Dein Code erstellt ja bereits einen neuen Eintrag. Gemäss deinem Text sollte das nicht so sein.
Zudem suchst du den Typ im Feld Leistungsstelle. Darum findet er nie etwas.

Du misst in deiner Funktion eine Weiche stellen.
Am Besten machst du für jede Aktion eine eigene Sub. Dann ist es einfacher zu programmieren und bleibt übersichtlicher
Der Unten stehende Code ist etwa das, was du beschrieben hast
Visual Basic:
Option Explicit

'/**
' * Event beim Doppelklicken auf das Worksheet
' * @param  Range       Angeklicktes Feld
' * @param  Boolean     Rückgabewert, Standardaktion von Doppelklick abbrechen
' */
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target.EntireRow, [Übersicht[Typ]]) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case 3: dblClickTyp Target      'Typ Filtern
        Case 4: dblClickToDo Target
    End Select
    Cancel = True
End Sub

'/**
' * Aktion beim Doppelklick auf ein Typ-Feld
' * @param  Range       Angeklicktes Feld
' * @return Range       Zeile im Sheet2
' */
Private Function dblClickTyp(ByVal Target As Range) As Range
    Dim lngNewRow   As Long
    
    With Sheet2
        .ListObjects(1).Range.AutoFilter 3, Criteria1:=Intersect(Target.EntireRow, [Übersicht[Typ]])
        .Activate
        lngNewRow = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
        Set dblClickTyp = .Rows(lngNewRow)
        .Cells(lngNewRow, 2).Select
    
    End With
    
End Function

'/**
' * Aktion beim Doppelklick auf ein ToDo-Feld
' * @param  Range       Angeklicktes Feld
' */
Private Sub dblClickToDo(ByVal Target As Range)
    Dim rngTyp As Range
    Set rngTyp = Target.Offset(0, -1)
    'In die Zeile aus dblClickTyp in die Spalte von Typ den Eintrag kopieren
    dblClickTyp(rngTyp).Cells(1, 4).Value = rngTyp.Value
End Sub
 
Zurück