Sortiervorgang ist sichtbar
mike49
in meiner Arbeitsmappe sind die Module "Linie" und "ModSortierung". Nach erflgtem Eintrag wird nach Betätigung der Return-Taste die Sortierung am Bildschirm sichtbar. Das sollte nicht sein. Was ist hier fehlerhaft?
Modul "Linie":
Option Explicit
Sub LinieSetzen()
Application.ScreenUpdating = False
Dim LoLetzte As Long
Dim Loi As Long
' letzte belegte Zeile unabhängig von Excelversion für Spalte A (1)
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
For Loi = LoLetzte To 4 Step -1
If Loi = LoLetzte And Cells(LoLetzte, 2) "" Then
With Range("A" & Loi & ":H" & Loi).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
ElseIf Month(Cells(Loi, 2)) Month(Cells(Loi - 1, 2)) Then
With Range("A" & Loi - 1 & ":H" & Loi - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
ElseIf Cells(Loi, 2) = "" And Cells(Loi - 1, 2) "" Then
With Range("A" & Loi - 1 & ":H" & Loi - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
Else
Range("A" & Loi - 1 & ":H" & Loi - 1).Borders(xlEdgeBottom).LineStyle = xlNone
End If
Next Loi
Application.ScreenUpdating = True
End Sub
Modul "ModSortierung":
Option Explicit
Public intZeilen As Integer
Sub Orte_sortieren()
Application.ScreenUpdating = False
'Zeilen in der Tabelle.
intZeilen = ActiveSheet.Range("A3").SpecialCells(xlLastCell).Row
'// Alle Orte nach Datum sortieren.
Sortiere_alle_Orte_nach_Datum
'// 1. Ort nach Datum + Uhrzeit sortieren.
Sortiere_Ort_1_nach_Datum_Uhrzeit
'// Letzten Ort (2 komplette Spalten) nach vorn verschieben.
Verschiebe_Spalten
'// Neuen 1. Ort nach Datum + Uhrzeit sortieren.
Sortiere_Ort_1_nach_Datum_Uhrzeit
'// Erneut: Letzten Ort (2 komplette Spalten) nach vorn verschieben.
Verschiebe_Spalten
'// Erneut: Neuen 1. Ort nach Datum + Uhrzeit sortieren.
Sortiere_Ort_1_nach_Datum_Uhrzeit
'// Abschließend: Letzten Ort wieder nach vorn verschieben.
Verschiebe_Spalten
'// Druckbereich.
'Benutzte Zeilen in der Tabelle.
intZeilen = ActiveSheet.Range("B2").End(xlDown).Row
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & intZeilen
'// Variablen zurücksetzen.
intZeilen = 0
Application.ScreenUpdating = True
End Sub
Private Sub Verschiebe_Spalten()
Application.ScreenUpdating = False
With ActiveSheet
.Columns("G:H").Cut
.Columns("C:C").Insert Shift:=xlToRight
End With
Application.ScreenUpdating = True
End Sub
Private Sub Sortiere_alle_Orte_nach_Datum()
Application.ScreenUpdating = False
With ActiveSheet
.Range("A3:H" & intZeilen).Sort _
Key1:=Range("B3"), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With
Application.ScreenUpdating = True
End Sub
Private Sub Sortiere_Ort_1_nach_Datum_Uhrzeit()
Application.ScreenUpdating = False
With ActiveSheet
.Range("A3:D" & intZeilen).Sort _
Key1:=Range("B3"), _
Order1:=xlAscending, _
Key2:=Range("D3"), _
Order2:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With
Dim LoLetzte As Long
Dim Loi As Long
' letzte belegte Zeile unabhängig von Excelversion für Spalte A (1)
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
For Loi = LoLetzte To 4 Step -1
If Loi = LoLetzte And Cells(LoLetzte, 2) "" Then
With Range("A" & Loi & ":H" & Loi).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
ElseIf Month(Cells(Loi, 2)) Month(Cells(Loi - 1, 2)) Then
With Range("A" & Loi - 1 & ":H" & Loi - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
ElseIf Cells(Loi, 2) = "" And Cells(Loi - 1, 2) "" Then
With Range("A" & Loi - 1 & ":H" & Loi - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
Else
Range("A" & Loi - 1 & ":H" & Loi - 1).Borders(xlEdgeBottom).LineStyle = xlNone
End If
Next Loi
Application.ScreenUpdating = True
End Sub
Freundliche Grüße
mike49