AW: Sortieren: Eingeblendete Zeilen unter ausgeblendet
06.08.2019 16:15:59
Andreas
Hallo
Ich hätte doch noch eine Frage. Das Macro Funktionier aber hättest du vielleicht einen Vorschlag wie ich das Macro schneller machen könnte (also abgesehen von .ScreenUpdating =false usw.) Es brauch zum verarbeiten 70 000 Datensätzen etwas zu lange. Ich glaub das liegt am Schreiben der Hilfsspalte.
https://www.herber.de/bbs/user/131297.xlsm
Option Explicit
Sub ZeilenUmsortieren()
Dim wsDaten As Worksheet
Dim iTabDaten As ListObject
Set wsDaten = ThisWorkbook.Worksheets("Daten")
Set iTabDaten = wsDaten.ListObjects("Daten_IntelligenteTabelle")
Dim iDatenLZ As Long, iDatenLS As Long 'letzte zeile u. Spalte v. ListObjekt
Dim i As Integer
iDatenLS = iTabDaten.ListColumns.Count
iDatenLZ = wsDaten.ListObjects("Daten_IntelligenteTabelle").ListRows.Count + 1
Call SpezialfilterDatum1(True)
For i = iDatenLZ To 2 Step -1
If iTabDaten.Range.Rows(i).Hidden = True Then wsDaten.Cells(i, iDatenLS + 1).Value = "Z"
Next
If wsDaten.FilterMode = True Then wsDaten.ShowAllData
'Jetzt Sortieren
Range("Daten_IntelligenteTabelle[#All]").Select
With iTabDaten
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("Daten_IntelligenteTabelle[S11]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("Daten_IntelligenteTabelle[S1]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.Header = xlYes
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
'iTabDaten.ListColumns(LetzteS).Delete
iTabDaten.DataBodyRange.Columns(iDatenLS).ClearContents
Call SpezialfilterDatum1
Range("A1").Select
End Sub
Sub SpezialfilterDatum1(Optional Kriterien As Boolean)
Dim Von As Date, Bis As Date
Dim wsDaten As Worksheet
Dim iTabDaten As ListObject
Set wsDaten = ThisWorkbook.Worksheets("Daten")
Set iTabDaten = wsDaten.ListObjects("Daten_IntelligenteTabelle")
'Filter Löschen
If wsDaten.AutoFilterMode = True Then If wsDaten.FilterMode = True Then wsDaten.AutoFilter. _
ShowAllData
If Kriterien Then 'Wenn True Übergeben dann Kriterien bereich erstellen
Von = wsDaten.OLEObjects("TextBox1").Object.Value 'Von
Bis = wsDaten.OLEObjects("TextBox2").Object.Value 'Bis
wsDaten.Range("AF23:AG23").Value = "Von"
wsDaten.Range("AH23:AI23").Value = "Bis"
'1 Kriterienzeile
wsDaten.Range("AF24").Value = ">=" & CLng(Von)
wsDaten.Range("AH24").Value = ">=" & CLng(Von)
wsDaten.Range("AG24").Value = "=" & CLng(Bis)
'2 Kriterienzeile
wsDaten.Range("AG25").Value = ">=" & CLng(Von)
wsDaten.Range("AH25").Value = "=" & CLng(Von)
wsDaten.Range("AG26").Value = "=" & (Von)
wsDaten.Range("AG30,AH31,AG32").Value = "=" & (Bis)
wsDaten.Range("AF32").Value = "
Danke und Grüße
Andreas