AW: Aktenzeichen sortieren
16.10.2015 15:19:56
Peter
Hallo Tobias,
hier eine VBA Lösung mit dem Excel-Sort und zwei temporären Hilfsspalten
Gruß Peter
Option Explicit
' Ich habe Akten zu verwalten, deren Aktenzeichen nach folgendem Format gebildet werden mü _
ssen:
' 34/03, 65/99, 25/02 usw., wobei die ersten beiden Ziffern die laufende Nummer eines _
Jahrgangs
' darstellen, und die Ziffern nach dem Schrägstrich den Jahrgang.
' Diese Zeichenfolgen befinden sich in Spalte A.
' Ich möchte nun die Akten so sortieren, dass die Jüngste am Ende der Liste steht, also
' 65/99
' 25/02
' 34/03
' Es muss aber unbedingt eine Sortierung erfolgen, damit ich überblicken kann, welche Akte _
ich schon erfaßt habe.
' sortiert wird das Tabellenblatt "Tabelle1"
' sortiert wird ab Zeile 1 - also OHNE ÜBERSCHRIFT
' sortiert wird Spalte A - Z
Public Sub Aktenzeichen_sortieren()
Dim lLetzte As Long ' die letzte belegte Zeile in Spalte A
Dim lZeile As Long ' For/Next Schleifen-index - hier die Zeile
Dim vTemp As Variant ' ein temporärer Bereich zum trennen am "/"
Application.ScreenUpdating = False ' kein Bildschirm-Update zulassen
With ThisWorkbook.Worksheets("Tabelle1") ' den Tabellen-Blattnamen ggf. ANPASSEN !!!
lLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row ' die letzte belegte Zeile gemäß Spalte 1 = _
A
.Columns("A:A").Insert Shift:=xlToRight ' 1. Hilfsspalte einfügen
.Columns("A:A").Insert Shift:=xlToRight ' 2. Hilfsspalte einfügen
For lZeile = 1 To lLetzte
If InStr(.Range("C" & lZeile).Value, "/") > 0 Then ' gibt es einen "/" ?
vTemp = Split(.Range("C" & lZeile).Value, "/") ' am "/" aufteilen
.Range("A" & lZeile).Value = vTemp(1) ' das Jahr in die 1. Hilfsspalte
.Range("B" & lZeile).Value = vTemp(0) ' die lfd. Nr in die 2. Hilfsspalte
Else
.Range("A" & lZeile).Value = .Range("C" & lZeile).Value ' Werte ohne den "/"
End If
Next lZeile
' die beiden Hilfsspalten sortieren - absteigend das Jahr, aufsteigend die lfd. Nummer
.Range("A1:AB" & lLetzte).Sort _
Key1:=Range("A1"), _
Order1:=xlDescending, _
Key2:=Range("B1"), _
Order2:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
.Columns("A:B").Delete Shift:=xlToLeft ' die Hilfsspalten wieder löschen
End With
Application.ScreenUpdating = True ' den Bildschirm-Update wieder zulassen
End Sub
In ein allgemeines Modul kopieren und über Alt + F8 starten