Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 08:56:18
Textbox in Tabellenblatt ohne Bestätigung in Zelle eintragen
20.04.2024 07:57:54
Tablle fürs E-Auto - Preis wenn kürzer als 60 Min Ladezeit
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1276to1280
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1276to1280
1276to1280
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code optimieren (beschleunigen)

Code optimieren (beschleunigen)
Charly
Hallo
Kann mir jemand helfen folgenden Code zu beschleunigen?
Bis zu ca. 150 Sheets ist's ok.
Ich hab aber bis 2000 Sheets und dann wird's zu langsam.
z = Sheets("Formular").Index + 1
For x = z To Worksheets.Count
For y = x To Worksheets.Count
If Worksheets(y).Name > Worksheets(x).Name Then
Worksheets(y).Move before:=Worksheets(x)
End If
Next y
Next x
Danke vorab.
MfG Charly

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Code optimieren (beschleunigen)
19.09.2012 13:27:14
Rudi
Hallo,
Application.Screenupdating=False
davor.
Gruß
Rudi

AW: Code optimieren (beschleunigen)
19.09.2012 13:35:35
Charly
Hallo Rudi
Danke, aber das hab ich.
Ich hatte an eine andere Möglichkeit gedacht.
Tabellennamen in Datenfeld einlesen und dann sortieren, geht sowas und bringt das was?
MfG Charly

AW: Code optimieren (beschleunigen)
19.09.2012 14:13:50
Rudi
Hallo,
Ich weiß ja nicht, was du langsam nennst.
Das ist aber wahrscheinlich schneller als deine Routine: 
Sub SheetsSortieren()
Dim i As Integer, arr(), iStart As Integer
iStart = Sheets("Formular").Index + 1
ReDim arr(iStart To Worksheets.Count)
Application.ScreenUpdating = False
For i = iStart To Worksheets.Count
arr(i) = Sheets(i).Name
Next
QuickSort arr
For i = Worksheets.Count To iStart Step -1
Worksheets(arr(i)).Move after:=Worksheets("Formular")
Next
End Sub


Sub QuickSort(ByRef DasArray, Optional ErsteZeile, Optional LetzteZeile)
On Error Resume Next
Dim UnterGrenze As Long, OberGrenze As Long
Dim AktuellerWert, GemerkterWert As Variant
If IsMissing(ErsteZeile) Then
ErsteZeile = LBound(DasArray)
End If
If IsMissing(LetzteZeile) Then
LetzteZeile = UBound(DasArray)
End If
UnterGrenze = ErsteZeile
OberGrenze = LetzteZeile
AktuellerWert = DasArray((ErsteZeile + LetzteZeile) / 2)
Do While (UnterGrenze  AktuellerWert And OberGrenze > ErsteZeile)
OberGrenze = OberGrenze - 1
Loop
If (UnterGrenze  ErsteZeile) Then Call QuickSort(DasArray, ErsteZeile, OberGrenze)
If (UnterGrenze

Gruß
Rudi

Anzeige
AW: Code optimieren (beschleunigen)
19.09.2012 19:06:26
Charly
Danke für deine Mühe Rudi.
Bringt aber nicht viel.
Bei 1950 Sheets
Mit der Ausgangsschleife 2 Min. 20 Sek.
Mit deiner Variante 2 Min. 10 Sek.
Danke trotz allem.
Schönen Abend noch.
MfG Charly

AW: Code optimieren (beschleunigen)
19.09.2012 22:36:02
Rudi
Hallo,
kommt ja auch auch den Rechner an.
Letztlich solte man über nen Algorithmus nachdenken, der nur die Sheets verschiebt, die nicht in der richtigen Reihenfolge sind.
Interessanter Job.
Gruß
Rudi

AW: Code optimieren (beschleunigen)
20.09.2012 08:57:05
Martin
Hallo Charly,
eventuell löst das Verschieben der Tabellenblätter das Calculate-Ereignis aus. Setze noch ein 
Application.Calculation = xlCalculationManual

an den Anfang deines Makros. Am Ende des Makros stellst du dann wieder auf die automatische Berechnung um: 
Application.Calculation = xlCalculationAutomatic
Ich weiß, dass die Autoberechnung an Stellen ausgelöst wird, an denen man es einfach nicht erwartet. Wenn das auch auf das Verschieben von Tabellenblättern zutrifft, kostet es viel Zeit. Einfach mal probieren.
Viele Grüße
Martin

Anzeige
AW: Code optimieren (beschleunigen)
20.09.2012 11:35:48
Rudi
Hallo,
umgefrickeltes Quicksort
Bei mit 7,5 Sek.
Sub Start()
Dim i As Integer, arrSheets(), iForm As Integer
Dim t
t = Timer
Application.ScreenUpdating = False
iForm = Sheets("Formular").Index
ReDim arrSheets(0 To Worksheets.Count - 1)
For i = LBound(arrSheets) To UBound(arrSheets)
arrSheets(i) = Sheets(i + 1).Name
Next
SortSheets arrSheets, iForm
Debug.Print Timer - t
End Sub


Sub SortSheets(ByRef DasArray, Optional ErsteZeile, Optional LetzteZeile)
On Error Resume Next
Dim UnterGrenze As Long, OberGrenze As Long
Dim AktuellerWert, GemerkterWert As Variant
If IsMissing(ErsteZeile) Then
ErsteZeile = LBound(DasArray)
End If
If IsMissing(LetzteZeile) Then
LetzteZeile = UBound(DasArray)
End If
UnterGrenze = ErsteZeile
OberGrenze = LetzteZeile
AktuellerWert = DasArray((ErsteZeile + LetzteZeile) / 2)
Do While (UnterGrenze  AktuellerWert And OberGrenze > ErsteZeile)
OberGrenze = OberGrenze - 1
Loop
If (UnterGrenze  ErsteZeile) Then Call SortSheets(DasArray, ErsteZeile, OberGrenze)
If (UnterGrenze

Gruß
Rudi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige