Drehfunktion des Spalteninhaltes optimieren
#1
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?


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
Top
#2
Hallo Kathrin

in meinem Test mit 15000 Zeilen benötigt Dein Makro "Drehen" 0,04 Sekunden
und Dein "Makro1" brauchte 0,4 Sekunden

MfG Tom
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste