03.10.2014, 12:10
Hallo Leute,
ich habe ein kleines funktionsfähiges Programm geschrieben, welches die in einer Spalte (hier: Spalte A) stehenden Werte in deren Reihenfolge umdreht. Gleichzeitig habe ich eine Makrorekorderaufzeichnung über die eingebaute Excel-Funktion Sortieren A-Z bzw. Z-A gemacht. Auch wenn Excel nicht direkt über meine geschriebene Funktion Drehen verfügt, ist der Sortieralgorithmus von MS doch wesentlich schneller. Und genau das ist meine Frage: Wie muss mein VBA Code verbessert werden, damit das Drehen schneller abläuft?
ich habe ein kleines funktionsfähiges Programm geschrieben, welches die in einer Spalte (hier: Spalte A) stehenden Werte in deren Reihenfolge umdreht. Gleichzeitig habe ich eine Makrorekorderaufzeichnung über die eingebaute Excel-Funktion Sortieren A-Z bzw. Z-A gemacht. Auch wenn Excel nicht direkt über meine geschriebene Funktion Drehen verfügt, ist der Sortieralgorithmus von MS doch wesentlich schneller. Und genau das ist meine Frage: Wie muss mein VBA Code verbessert werden, damit das Drehen schneller abläuft?
Code:
Private Declare PtrSafe Function GetTime Lib "winmm.dll" Alias "timeGetTime" () As Long
Sub Drehen()
Dim vbx As Long, vbT1 As Long
Dim letzteZeile As Long, vbgr As Long
Dim tmp As Variant
vbT1 = GetTime
letzteZeile = Range("A" & Rows.Count).End(xlUp).Row
vbgr = letzteZeile
vbx = Round(letzteZeile / 2, 0.5)
Var = Range("A1:A" & letzteZeile).Value
For i = 1 To vbx
tmp = Var(i, 1)
Var(i, 1) = Var(letzteZeile, 1)
Var(letzteZeile, 1) = tmp
letzteZeile = letzteZeile - 1
Next i
Range("A1:A" & vbgr).Value = Var[b][/b]
End Sub
'Makrorekorderaufzeichnung von MS:
Sub Makro1()
Dim vbT1 As Long
vbT1 = GetTime
Columns("A:A").Select
ActiveWorkbook.Worksheets("Tabelle2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle2").Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle2").Sort
.SetRange Columns("A:A")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MsgBox GetTime - vbT1
End Sub