Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

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
Antworten 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
Antworten Top


Gehe zu:


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