AW: Zeilen filtern
22.02.2008 11:08:00
Nepumuk
Hallo Niko,
na ein bisschen mehr muss schon angepasst werden.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_Open()
Call prcCreate_Validation
End Sub
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCell As Range
If Target.Address = "$E$11" Then
If Target.Value = "" Or Target.Value = "Alle" Then
Me.Columns.Hidden = False
Else
Set objCell = Me.Rows(15).Find(What:=Target.Value)
If Not objCell Is Nothing Then
Range(Cells(15, 7), Cells(15, Columns.Count). _
End(xlToLeft)).EntireColumn.Hidden = True
objCell.EntireColumn.Hidden = False
End If
End If
ElseIf Target.Row = 15 Then
Call prcCreate_Validation
End If
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Public Sub prcCreate_Validation()
Dim vntArray As Variant
Dim strArray() As String
Dim lngIndex As Long, lngCounter As Long
With Tabelle1
vntArray = .Range(.Cells(15, 7), .Cells(15, .Columns.Count).End(xlToLeft)).Value
Redim strArray(0 To UBound(vntArray, 2))
strArray(0) = "Alle"
For lngIndex = LBound(vntArray, 2) To UBound(vntArray, 2)
lngCounter = lngCounter + 1
strArray(lngCounter) = vntArray(1, lngIndex)
Next
Application.EnableEvents = False
.Cells(11, 5).ClearContents
Application.EnableEvents = True
With .Cells(11, 5).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(strArray, ",")
End With
End With
End Sub
Gruß
Nepumuk