Live-Forum - Die aktuellen Beiträge
Datum
Titel
22.10.2025 16:04:18
Auswahl der Datenüberprüfung auf Folgezellen übertragen
22.10.2025 15:36:11
wie oft kommt ein Buchstabe in einem Array vor, Zählenwenn
22.10.2025 15:30:07
Beitragsproblem im Forum behoben
20.10.2025 19:34:56
Eine Zelle in 3 Spalten teilen
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
808to812
808to812
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro beschleunigen

Forumthread: Makro beschleunigen

Makro beschleunigen
10.10.2006 00:10:01
Bernd
Hallo,
folgendes Makro benötigt ungefähr 10 Sekunden. Kann ich das irgendwie beschleunigen?
Gruss
Bernd 

Sub daten_übertragen()
' Schaltet das Zeigen des Programmaufblaufes auf dem Bildschirm aus
Application.ScreenUpdating = False
' Beseitgt im Blatt "Meldung" alle verbundenen Zellen
Sheets("Meldung").Select
Dim Zelle As Range
For Each Zelle In ActiveSheet.UsedRange
If Zelle.MergeCells Then
Zelle.UnMerge
End If
Next Zelle
' Sortiert Liste (Gesamtliste) nach Spalte DG
Columns("A:I").Sort Key1:=Range("I2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
' Filtert Liste nach aktuellen Abwesenheiten.
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=7, Criteria1:="Aktuell"
' Löscht den Inhalt des Blattes "Meldung"
Sheets("Meldung").Cells.ClearContents
' Fügt oberen Teil der Meldung ein
Sheets("Legende").Range("Meldung_oberer_Teil").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Fügt Überschrift Gruppe1 ein
Sheets("Legende").Range("Überschrift_Gruppe1").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Ergänzung w/ Fehler der Deaktivierung von verschmelzten Zellen:
With Sheets("Meldung").Range("A65000").End(xlUp).Range("A1:E1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
' Filtert Liste nach Gruppe1 und fügt gefilterte Liste in Blatt "Meldung" nahtlos an
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=8, Criteria1:="Gruppe1"
Sheets("Gesamtliste").Range("A2:E30001").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Fügt Überschrift Gruppe2 ein
Sheets("Legende").Range("Überschrift_Gruppe2").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Ergänzung w/ Fehler der Deaktivierung von verschmelzten Zellen:
With Sheets("Meldung").Range("A65000").End(xlUp).Range("A1:E1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
' Filtert Liste nach Gruppe2 und fügt gefilterte Liste in Blatt "Meldung"  nahtlos an
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=8, Criteria1:="Gruppe2"
Sheets("Gesamtliste").Range("A2:E30001").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Fügt Überschrift Gruppe3 ein
Sheets("Legende").Range("Überschrift_Gruppe3").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Ergänzung w/ Fehler der Deaktivierung von verschmelzten Zellen:
With Sheets("Meldung").Range("A65000").End(xlUp).Range("A1:E1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
' Filtert Liste nach Gruppe3 und fügt gefilterte Liste in Blatt "Meldung"  nahtlos an
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=8, Criteria1:="Gruppe3"
Sheets("Gesamtliste").Range("A2:E30001").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Fügt Überschrift Langzeit ein
Sheets("Legende").Range("Überschrift_Langzeit").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Filtert Liste nach Langzeit und fügt gefilterte Liste in Blatt "Meldung"  nahtlos an
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=8, Criteria1:="Langzeit"
Sheets("Gesamtliste").Range("A2:E30001").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Fügt unteren Teil der Meldung ein
Sheets("Legende").Range("Meldung_unterer_Teil").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Ergänzung w/ Fehler der Deaktivierung von verschmelzten Zellen:
With Sheets("Meldung").Range("A65000").End(xlUp).Range("A1:E1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
' Fügt Rahmen in der Meldung ein
Sheets("Meldung").Range("A14:E14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders.LineStyle = xlContinuous
' Hebt sämtliche Filterungen auf.
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=7
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=8
' Gibt Messagebox aus
MsgBox "Meldung für gewünschten Tag erstellt!"
End Sub

Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro beschleunigen
10.10.2006 00:28:43
Ali
Hi,
Option Explicit

Sub til()
Dim appCalculation As Long
appCalculation = Application.Calculation
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
On Error GoTo ErrorExit
'dein Code
ErrorExit:
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = appCalculation
End With
End Sub

mfg Ali
Anzeige
Fehler, siehe Korrektur anderes posting
10.10.2006 00:30:39
Ali
a
AW: Makro beschleunigen
10.10.2006 11:54:40
Bernd
Danke Ali,
das probiere ich gleich mal aus.
Könntest du deinen Code vielleicht dennoch nochmal etwas erläutern, damit ich ihn zumindest verstehe.

Sub Ali()
Dim appCalculation As Long
appCalculation = Application.Calculation
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
On Error GoTo ErrorExit
End Sub

Vor allem: was ist EnableEvents?
Gruss
bernd
Anzeige
AW: Makro beschleunigen
10.10.2006 12:08:21
Bernd
... erledigt.
Ich hab jetzt ein viel schlimmeres Problem. Siehe neuen Thread
AW: Makro beschleunigen
10.10.2006 00:29:31
Ali
Hi,
Option Explicit

Sub til()
Dim appCalculation As Long
appCalculation = Application.Calculation
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
On Error GoTo ErrorExit
'dein Code
ErrorExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = appCalculation
End With
End Sub

mfg Ali
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige