AW: Selektion nach Doppelklick und Referenz
21.06.2019 12:50:11
Werner
Hallo Jens,
meinst du so?
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim raFund As Range, loSpalte As Long, loLetzte As Long
Dim loLetzteSpalte As Long, i As Long
Select Case Target.Column
Case 1
With Worksheets("Liste")
.Columns.Hidden = False
If .AutoFilterMode Then .ShowAllData
loLetzteSpalte = .Cells(2, .Columns.Count).End(xlToLeft).Column
Set raFund = .Rows(4).Find(what:=Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
Cancel = True
loSpalte = raFund.Column
Else
MsgBox Target.Value & " ist im Blatt Liste nicht vorhanden."
Exit Sub
End If
loLetzte = .Cells(.Rows.Count, loSpalte).End(xlUp).Row
.Range("$D$4:$O$" & loSpalte).AutoFilter Field:=loSpalte - 3, Criteria1:=""
For i = loLetzteSpalte To 5 Step -1
If .Cells(2, i) Target.Offset(, 1).Value Then
.Columns(i).Hidden = True
End If
Next i
.Activate
End With
Case 2
With Worksheets("Liste")
.Columns.Hidden = False
If .AutoFilterMode Then .ShowAllData
loLetzteSpalte = .Cells(2, .Columns.Count).End(xlToLeft).Column
Set raFund = .Rows(4).Find(what:=Target.Offset(, -1).Value, LookIn:=xlValues, _
lookat:=xlWhole)
If Not raFund Is Nothing Then
Cancel = True
loSpalte = raFund.Offset(, -1).Column
Else
MsgBox Target.Value & " ist im Blatt Liste nicht vorhanden."
Exit Sub
End If
loLetzte = .Cells(.Rows.Count, loSpalte).End(xlUp).Row
.Range("$D$4:$O$" & loSpalte).AutoFilter Field:=loSpalte - 2, Criteria1:=""
For i = loLetzteSpalte To 5 Step -1
If .Cells(2, i) Target.Value Then
.Columns(i).Hidden = True
End If
Next i
.Activate
End With
Case Else
End Select
Set raFund = Nothing
End Sub
Gruß Werner