AW: Sortierfunktion
05.02.2013 12:21:13
Peter
Hallo Ludmila,
nachdem ich den Sort auf dem PC eines Freundes eingefügt habe, hier mei (bei mir) funktionierender Code:
Public Sub Sortieren()
Dim WkSh As Worksheet
Dim lLetzte As Long
Dim lZeile As Long
Dim vTemp As Variant
Dim iIndx As Integer
Set WkSh = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen
Application.ScreenUpdating = False
With WkSh
lLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
' 4 Spalten vor Spalte A mit den Daten einfügen
For iIndx = 1 To 4
.Columns("A:A").Insert Shift:=xlToRight
Next iIndx
.Columns("A:D").NumberFormat = "@"
' ab Zeile 1 in jetzt Spalte 5 = E
For lZeile = 1 To .Cells(.Rows.Count, 5).End(xlUp).Row
If Trim$(.Range("E" & lZeile).Value) "" Then
vTemp = Split(.Range("E" & lZeile).Value, ".")
For iIndx = 0 To UBound(vTemp)
.Cells(lZeile, iIndx + 1).Value = Format(vTemp(iIndx), "0000")
Next iIndx
End If
' leere Hilfs-Zellen mit 0000 auffüllen
For iIndx = 1 To 4
If .Cells(lZeile, iIndx) = "" Then .Cells(lZeile, iIndx).Value = "0000"
Next iIndx
Next lZeile
' hier den Sort nach den ersten vier Spalten einbauen
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A1:A" & lLetzte), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
.Sort.SortFields.Add Key:=Range("B1:B" & lLetzte), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
.Sort.SortFields.Add Key:=Range("C1:C" & lLetzte), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
.Sort.SortFields.Add Key:=Range("D1:D" & lLetzte), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
With WkSh.Sort
.SetRange Range("A1:E" & lLetzte)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' hier die 4 Hilfsspalten wieder löschen
.Columns("A:D").Delete Shift:=xlToLeft
End With
Application.ScreenUpdating = True
End Sub
Gruß Peter