Excel VBA - Anwendungen

Filtern

Autofilter und Formular (bei leerer Zelle)

s. a. http://excelbibel.de/datenformular-excel/

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Dim Spalte
Dim AktuellerWert As String
Dim Arbeitsblatt

'Tabellenblatt wird ermittelt
'TabellenName = ActiveWorkbook.ActiveSheet.Name  '"Tickets" wird ausgegeben, das hilft mir nicht

Arbeitsblatt = ActiveSheet.Name
 
Spalte = ActiveCell.Column

AktuellerWert = ActiveCell.Value

'Wenn Autofilter nicht gesetzt, ist setze ihn
 If Not ThisWorkbook.ActiveSheet.AutoFilterMode = True Then
   ThisWorkbook.ActiveSheet.Range("A1").AutoFilter
 End If
  
If AktuellerWert <> "" Then
'Autofilter auf dem Zellwert
  ThisWorkbook.ActiveSheet.Range(Spalte & ":1").AutoFilter Field:=Spalte, Criteria1:=AktuellerWert, Operator:=xlAnd, VisibleDropDown:=True
Else
  'Formular/Maske 
  ActiveSheet.ShowDataForm
End If
 
End Sub

Filter entfernen

'Filter setzen, bzw. entfernen, wenn vorher aktiv
Sub Filter()
 Tabelle1.Range("A1").AutoFilter
End Sub

Spalten filtern nach einem Wert mit Doppelklick

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Dim Spalte
Dim AktuellerWert As String

Spalte = ActiveCell.Column

AktuellerWert = ActiveCell.Value

'Wenn Autofilter nicht gesetzt, ist setze ihn
If Not ThisWorkbook.ActiveSheet.AutoFilterMode = True Then
  ThisWorkbook.ActiveSheet.Range("A1").AutoFilter
End If
 
'Autofilter auf dem Zellwert
ThisWorkbook.ActiveSheet.Range(Spalte & ":1").AutoFilter Field:=Spalte, Criteria1:=AktuellerWert, Operator:=xlAnd, VisibleDropDown:=True

End Sub

Bearbeitungsdatum nach "Heute" und "Gestern" filtern

'Es wird ein Filter auf das Systemdatum gesetzt
'Also zeige mir alle Tickets, die heute bearbeitet wurden
Sub DatumHeute()
  Dim str_datum As String 

  str_datum = Date

  If Not Tabelle1.AutoFilterMode = True Then
   Tabelle1.Range("F1").AutoFilter
  End If
   
  Tabelle1.Range("F1").AutoFilter Field:=6, Criteria1:=str_datum, Operator:=xlAnd, VisibleDropDown:=True
End Sub

und

'Zeige mir alle Tickets, die gestern bearbeitet wurden
Sub DatumGestern()
Dim str_datum As String

str_datum = Date - 1

  If Not Tabelle1.AutoFilterMode = True Then
   Tabelle1.Range("F1").AutoFilter
  End If
  
  Tabelle1.Range("F1").AutoFilter Field:=6, Criteria1:=str_datum, Operator:=xlAnd, VisibleDropDown:=True
End Sub

Filter setzen auf 'X'

'Filter auf X auf Feld A. (Aktiv)
Sub FilterX()
  If Not Tabelle1.AutoFilterMode = True Then
   Tabelle1.Range("H1").AutoFilter
  End If
  
  Tabelle1.Range("H1").AutoFilter Field:=8, Criteria1:="X", _
  Operator:=xlAnd, VisibleDropDown:=True
End Sub

Datei speichern ohne Hinweis und Schließen

'Listing 7.4.: Beim Schließen der Mappe Automatisch speichern ohne Rückfrage
'Held VBA, S. 195
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Application.DisplayAlerts = False
  ThisWorkbook.Save
  ThisWorkbook.Close
End Sub