Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Liste nach Kriterien Filtern und Ergebnisse in ListBox eintragen

Gruppe

Filtern

Problem

Bei Eingaben in den Zellen F1, F2 oder F3 sollen die Werte in der Tabelle gefiltert und die sichtbaren Werte in die ListBox eingetragen werden.

Lösung
Geben Sie den Ereigniscode in das Klassenmodul des Arbeitsblattes ein.

ClassModule: Tabelle1

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim iCol As Integer
   Dim sFilter As String
   If Target.Cells.Count > 1 Then Exit Sub
   iCol = Target.Column - 5
   sFilter = Target.Value
   If Intersect(Range("F2:H2"), Target) Is Nothing Then
      Exit Sub
   Else
      Call GetFilter(iCol, sFilter)
      Calculate
   End If
End Sub

StandardModule: Modul1

Sub GetFilter(iColT As Integer, sFilterT As String)
   Dim wks As Worksheet
   Dim rng As Range, rngFilter As Range
   Dim iCol As Integer
   On Error GoTo ERRORHANDLER
   Set wks = ActiveSheet
   Set rng = Range("A1").CurrentRegion
   rng.AutoFilter field:=iColT, Criteria1:="=" & sFilterT
   Set rngFilter = rng.SpecialCells(xlCellTypeVisible)
   Workbooks.Add 1
   rngFilter.Copy Range("A1")
   Rows(1).Delete
   With Tabelle1.lstFilter
      .Clear
      .List = Range("A1").CurrentRegion.Value
   End With
   ActiveWorkbook.Close savechanges:=False
ERRORHANDLER:
   wks.AutoFilterMode = False
   Application.EnableEvents = True
   If Err > 0 Then
      Err.Clear
      MsgBox "Es wurden keine Werte gefunden!"
      If ActiveWorkbook.Name <> ThisWorkbook.Name Then
         ActiveWorkbook.Close savechanges:=False
         ActiveSheet.AutoFilterMode = False
      End If
   End If
End Sub
Sub a()
Application.EnableEvents
End Sub