20.02.2018, 13:42
Hallo,
ich habe ein recht großes Makro zum Sortieren und abgleichen einer Personal Liste. Dieses wird per Schaltfläche ausgelöst.
Jetzt möchte ich gern das falls jemand die Liste gefiltert hat das alle Filter vorab entfernt werden. Soweit habe ich das ganze auch hin bekommen,
Allerdings habe ich jetzt das Problem das wenn ich das Makro auslöse ohne das ein Filter gesetzt ist das sich dieses dann aufhängt.
Ich habe zwar eine grobe Vorstellung wie ich das ganze anpassen muss, bekomme es aber nicht hin da ich mich in VBA nicht ganz so gut auskenne.
Ich hoffe Ihr könnt wir helfen wie das dann genau aussehen muss.
Gruß David
ich habe ein recht großes Makro zum Sortieren und abgleichen einer Personal Liste. Dieses wird per Schaltfläche ausgelöst.
Jetzt möchte ich gern das falls jemand die Liste gefiltert hat das alle Filter vorab entfernt werden. Soweit habe ich das ganze auch hin bekommen,
Allerdings habe ich jetzt das Problem das wenn ich das Makro auslöse ohne das ein Filter gesetzt ist das sich dieses dann aufhängt.
Ich habe zwar eine grobe Vorstellung wie ich das ganze anpassen muss, bekomme es aber nicht hin da ich mich in VBA nicht ganz so gut auskenne.
Ich hoffe Ihr könnt wir helfen wie das dann genau aussehen muss.
Code:
Sub Sortieren()
ActiveSheet.Unprotect
ActiveWorkbook.Worksheets("EVA").AutoFilter.Sort.SortFields.Clear
ActiveSheet.ShowAllData
Dim ListEva
Dim Listalfa
Dim intI As Integer
Dim intJ As Integer
Dim SuchNr
Dim stimmt As Boolean
Dim Plus As Integer
Dim Ende As Integer
' suchen nach gefülltem Ende in Eva
Ende = ThisWorkbook.Sheets("EVA").Cells(Rows.Count, 1).End(xlUp).Row
'Aufgabenstellung fehlende in Alfa rot zu markieren
Plus = 1
ListEva = ThisWorkbook.Sheets("EVA").Cells(4, 1).CurrentRegion
Listalfa = ThisWorkbook.Sheets("Alpha-Liste").Cells(4, 1).CurrentRegion
For intI = 4 To Ende
SuchNr = ListEva(intI, 1)
stimmt = 0
For intJ = 3 To UBound(Listalfa)
If SuchNr = Listalfa(intJ, 2) Then
stimmt = 1
Exit For
Else
End If
Next intJ
If intJ = UBound(Listalfa) + 1 And stimmt = 0 Then
ThisWorkbook.Sheets("EVA").Cells(intI, 1).Font.Color = -16776961
End If
Next intI
'Aufgabenstellung fehlende in Eva unten zu ergänzen
For intJ = 3 To UBound(Listalfa)
SuchNr = Listalfa(intJ, 2)
stimmt = 0
For intI = 4 To Ende
If SuchNr = ListEva(intI, 1) Then
stimmt = 1
Exit For
Else
End If
Next intI
If intI = Ende + 1 And stimmt = 0 Then
ThisWorkbook.Sheets("EVA").Cells(Ende + Plus, 1) = SuchNr
Plus = Plus + 1
End If
Next intJ
'
ActiveWorkbook.Worksheets("EVA").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("EVA").AutoFilter.Sort.SortFields.Add Key:=Range( _
"F3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("EVA").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:= _
True
End Sub