AW: Filter horizontal nach DropDown Auswahl
14.12.2017 15:43:45
Mullit
Hallo,
ok, habs Dir mal auf Deinen Bedingungen angepasst, da Du doppelte Vorkommen hast, wird nach jedem neuen Anwählen ab dem nächsten Fund eingeblendet, per Doppelklick auf Dein Dropdown kannst Du das Ausblenden resetten, das sind übrigens Ereignisprozeduren, d.h. der Code kommt in das Modul Deines Auswahl-Blattes...
' **********************************************************************
' Modul: Tabelle1(Auswahl) Typ: Klassenmodul des Tabellenblattes
' **********************************************************************
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Address = "$G$7" Then
Cancel = True
Range(.Offset(0, 1), Cells(.Row, Columns.Count).End(xlToLeft)).EntireColumn.Hidden = False
End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCell As Range
With Target
If .Address = "$G$7" Then
Application.ScreenUpdating = False
With Range(.Offset(0, 1), Cells(.Row, Columns.Count).End(xlToLeft))
Set objCell = .Find(What:=Trim$(Target.Value), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not objCell Is Nothing Then
.EntireColumn.Hidden = False
Range(Columns(Target.Column + 2), Columns(objCell.Column - 1)).EntireColumn.Hidden = True
Else
.EntireColumn.Hidden = False
Set objCell = .Find(What:=Trim$(Target.Value), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
With Target
If objCell.Column > .Column + 2 Then _
Range(Columns(.Column + 2), Columns(objCell.Column - 1)).EntireColumn.Hidden = True
End With
End If
End With
Set objCell = Nothing
Application.ScreenUpdating = True
End If
End With
End Sub
VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel
Code erstellt und getestet in Office 14
Gruß, Mullit