Hier die Datei u. Code
14.03.2017 09:17:09
Max2
Guten Morgen,
anbei die Datei, ich habe mal alles was ich gemacht habe kommentiert.
Vielleicht hilft es ja den Code besser zu verstehen.
Sollte etwas noch nicht ganz funktionieren oder sonst was, dann geb bescheid.
Drücke ALT + F11 und dann Doppelklick auf "ToDoListe" bzw. Tabelle1.
Dort befindet sich das "Hauptprogramm" welches Unterprogramme und Funktionen aufruft.
Hier die nachgebaute Datei mit Code: https://www.herber.de/bbs/user/112160.xlsm
Gruß Max2
Für alle die nichts Downloaden wollen und nur den Code sehen wollen:
Worksheet_Change():
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Boolean
Dim spalteJ As Long
Dim spalteA As Long
'//Wir übergeben diese Variablen später
'//als Parameter für den Sub "Filter"
spalteJ = 10
spalteA = 1
'//Wir prüfen ob die änderung in Spalte
'//A oder Spalte J stattgefunden hat und
'//der Zellinhalt nicht nichts ist... also Leer
If Target.Column = 1 Or Target.Column = 10 Then
If Target.Value "" Then
'//Zählt ob in Spalte j die Summe größer 0 ist
'//befindet sich in Modul: "Zählen"
Call counter
'//Falls ja dann Parameter für Spalte J
'//Falls nein dann Parameter für Spalte A
'//Der Sub Filter befindet sich im Modul "Sortieren"
If counter = True Then
Call Filter(spalteJ)
Else
Call Filter(spalteA)
End If
End If
End If
End Sub
Zähler Funktion:
Option Explicit
Function counter() As Boolean
Dim ws As Worksheet
Dim count As Integer
Dim lzeile As Long
Dim i
i = 2
Set ws = ThisWorkbook.Sheets("ToDoListe")
With ws
'//ermittelt die letzte Zeile in Spalte J
lzeile = .Cells(.Rows.count, 10).End(xlUp).Row
'//Wir haben einen Zähler namens "count"
'//dieser wird um eins erhöht wenn eine
'//der Zellen in Spalte J größer 0 ist
Do
If .Cells(i, 10).Value > 0 Then
count = count + 1
End If
i = i + 1
'//das Abbruch kriterium
'//kann auch durch: Loop Until count > 0
'//ersetzt werden
Loop Until i > lzeile
'//Wenn count größer null ist dann
'//setzten wir unsere Function auf True
'//dies entscheidet ob der Filter auf
'//Spalte A oder Spalte J angewendet wird!
If count > 0 Then counter = True
End With
End Function
Sub für den AutoFilter:
Option Explicit
Sub Filter(ByVal x As Long)
Dim ws As Worksheet
Dim lzeile As Long
Set ws = ThisWorkbook.Sheets("ToDoListe")
With ws
'//Wir ermitteln die Letzte benutze Zeile der spalte x
'//x ist der Parameter der übergeben wurde
'//x ist also 1 oder 10
lzeile = .Cells(.Rows.count, x).End(xlUp).Row
End With
'//Wir selecten die Zelle x1 also A1 o. J1
'//und erstellen den AutoFilter
ThisWorkbook.Sheets("ToDoListe").Cells(1, x).Select
Selection.AutoFilter
'//Die Range "Cells(2, x), Cells(lzeile, x)"
'//umfasst den Bereich der Spalte x
ActiveWorkbook.Worksheets("ToDoListe").AutoFilter.sort.SortFields.Add Key:= _
Range(Cells(2, x), Cells(lzeile, x)), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
'//hier sind die Optionen des Filters
'//möchte man das "Sortierverhalten" ändern
'//muss man ".Orientation = ..." abändern
With ActiveWorkbook.Worksheets("ToDoListe").AutoFilter.sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'//dadurch wird der Filter wieder entfernt
Selection.AutoFilter
Cells(lzeile, x).Select
End Sub
