Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1564to1568
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
Inhaltsverzeichnis

Makro beschläuigen/Excel beschläunigen

Makro beschläuigen/Excel beschläunigen
26.06.2017 11:55:06
Martina
Hallo zusammen,
ich habe in einer Excel-Datei 3 ähnliche Makros, die alle sehr lange Laufzeiten haben.
Hat jemand eine Idee, wie ich das optimieren könnte?
Mein Makro:

Sub ProtokollErstellen()
Dim olddate As String
'Beschleunigen:
With Application
.ScreenUpdating = False 'Bildschirm anzeigen
.EnableEvents = False
.Calculation = xlCalculationManual 'Berechnung ausschalten
End With
Worksheets("Protokoll").Unprotect 'Passwort aufheben
Worksheets("Protokoll").Columns("L:AZ").Clear 'Zeilen löschen
Worksheets("Punkte").Select
olddate = InputBox("Bitte das Datum eingeben", "Anwesenheitsliste erstellen")
If StrPtr(olddate) = 0 Then
Exit Sub
Else
[A:AD].AutoFilter Field:=17, Criteria1:="=" & olddate 'Autofilter anwenden
ActiveSheet.Range("A3:AG" & ActiveSheet.UsedRange.Rows.Count). _
SpecialCells(xlCellTypeVisible).Copy 'Autofilterdaten kopieren
End If
'...und ab "L28" in Tabelle2 einfügen
Worksheets("Protokoll").Range("L28").PasteSpecial
Worksheets("Protokoll").Calculate
'Formatierung ändern
Worksheets("Protokoll").Select
Columns("L:AZ").Select
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Optimale Zeilenhöhe
Sheets("Protokoll").Rows("28:62").EntireRow.AutoFit
'AutoFilter löschen
Sheets("Punkte").Select
Dim intI As Integer
With Worksheets("Punkte")
For intI = 1 To 31  ' hier bitte die Anzahl der Spalten mit Filter eingeben
Selection.AutoFilter Field:=intI
Next
End With
Worksheets("Protokoll").Select
Range("A1").Select
'Abfrage PDF Erstellen
If MsgBox("PDF erstellen?", vbYesNo) = vbNo Then
Application.ScreenUpdating = True
Worksheets("Protokoll").Protect
Exit Sub
ElseIf vbYes Then
Rem Pfad und Name der PDF-Datei
NeuerName = Range("Y28")
pdfName = "X:\Betriebsrat\BR-Sitzungen\2017\03 Sitzungsprotokoll 2017" & "\" & " _
Betriebsratsprotokoll_" & Format(NeuerName, "yyyy-mm-dd") & ".pdf"
Rem PDF-Datei erstellen
Worksheets("Protokoll").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False,  _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
With Application
'Rückgängig Beschleunigen:
With Application
.ScreenUpdating = True 'Bildschirm anzeigen
.EnableEvents = True
.Calculation = xlCalculationAutomatic 'Berechnung einschalten
End With
Worksheets("Protokoll").Protect 'Schutz setzen
End With
End Sub

Vielen Dank
Martina

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro beschläuigen/Excel beschläunigen
26.06.2017 13:41:39
Robert
Probiere mal folgendes:
Sub ProtokollErstellen()
Dim olddate As String
Application.ScreenUpdating = False   'Makro verbergen
'Beschleunigen:
With Application
.ScreenUpdating = False 'Bildschirm anzeigen
.EnableEvents = False
.Calculation = xlCalculationManual 'Berechnung ausschalten
End With
Worksheets("Protokoll").Unprotect 'Passwort aufheben
Worksheets("Protokoll").Columns("L:AZ").Clear 'Zeilen löschen
Worksheets("Punkte").Select
olddate = InputBox("Bitte das Datum eingeben", "Anwesenheitsliste erstellen")
If StrPtr(olddate) = 0 Then
Exit Sub
Else
[A:AD].AutoFilter Field:=17, Criteria1:="=" & olddate 'Autofilter anwenden
ActiveSheet.Range("A3:AG" & ActiveSheet.UsedRange.Rows.Count). _
SpecialCells(xlCellTypeVisible).Copy 'Autofilterdaten kopieren
End If
'...und ab "L28" in Tabelle2 einfügen
Worksheets("Protokoll").Range("L28").PasteSpecial
Worksheets("Protokoll").Calculate
'Formatierung ändern
Worksheets("Protokoll").Select
Columns("L:AZ").Select
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Optimale Zeilenhöhe
Sheets("Protokoll").Rows("28:62").EntireRow.AutoFit
'AutoFilter löschen
Sheets("Punkte").Select
Dim intI As Integer
With Worksheets("Punkte")
For intI = 1 To 31  ' hier bitte die Anzahl der Spalten mit Filter eingeben
Selection.AutoFilter Field:=intI
Next
End With
Worksheets("Protokoll").Select
Range("A1").Select
'Abfrage PDF Erstellen
If MsgBox("PDF erstellen?", vbYesNo) = vbNo Then
Application.ScreenUpdating = True
Worksheets("Protokoll").Protect
Exit Sub
ElseIf vbYes Then
Rem Pfad und Name der PDF-Datei
NeuerName = Range("Y28")
pdfName = "X:\Betriebsrat\BR-Sitzungen\2017\03 Sitzungsprotokoll 2017" & "\" & " _
Betriebsratsprotokoll_" & Format(NeuerName, "yyyy-mm-dd") & ".pdf"
Rem PDF-Datei erstellen
Worksheets("Protokoll").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False,  _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
With Application
'Rückgängig Beschleunigen:
With Application
.ScreenUpdating = True 'Bildschirm anzeigen
.EnableEvents = True
.Calculation = xlCalculationAutomatic 'Berechnung einschalten
End With
Worksheets("Protokoll").Protect 'Schutz setzen
End With
Application.ScreenUpdating = True 'Makro Anzeigen
End Sub

Anzeige
AW: Makro beschleunigen/Excel beschleunigen
26.06.2017 14:09:50
Martina
Hallo Robert,
vielen Dank. Leider keine Verbesserung :-(
Wenn die Datei wirklich sehr groß wäre, könnte ich verstehen dass das länger dauert - aber so ist das komisch...
mfg
Martina
AW: Makro beschleunigen/Excel beschleunigen
26.06.2017 14:13:51
Robert
habe etwas verändert. nun?
Sub ProtokollErstellen()
Application.ScreenUpdating = False   'Makro verbergen
Dim olddate As String
'Beschleunigen:
With Application
.EnableEvents = False
.Calculation = xlCalculationManual 'Berechnung ausschalten
End With
Worksheets("Protokoll").Unprotect 'Passwort aufheben
Worksheets("Protokoll").Columns("L:AZ").Clear 'Zeilen löschen
Worksheets("Punkte").Select
olddate = InputBox("Bitte das Datum eingeben", "Anwesenheitsliste erstellen")
If StrPtr(olddate) = 0 Then
Exit Sub
Else
[A:AD].AutoFilter Field:=17, Criteria1:="=" & olddate 'Autofilter anwenden
ActiveSheet.Range("A3:AG" & ActiveSheet.UsedRange.Rows.Count). _
SpecialCells(xlCellTypeVisible).Copy 'Autofilterdaten kopieren
End If
'...und ab "L28" in Tabelle2 einfügen
Worksheets("Protokoll").Range("L28").PasteSpecial
Worksheets("Protokoll").Calculate
'Formatierung ändern
Worksheets("Protokoll").Select
Columns("L:AZ").Select
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Optimale Zeilenhöhe
Sheets("Protokoll").Rows("28:62").EntireRow.AutoFit
'AutoFilter löschen
Sheets("Punkte").Select
Dim intI As Integer
With Worksheets("Punkte")
For intI = 1 To 31  ' hier bitte die Anzahl der Spalten mit Filter eingeben
Selection.AutoFilter Field:=intI
Next
End With
Worksheets("Protokoll").Select
Range("A1").Select
'Abfrage PDF Erstellen
If MsgBox("PDF erstellen?", vbYesNo) = vbNo Then
Application.ScreenUpdating = True
Worksheets("Protokoll").Protect
Exit Sub
ElseIf vbYes Then
Rem Pfad und Name der PDF-Datei
NeuerName = Range("Y28")
pdfName = "X:\Betriebsrat\BR-Sitzungen\2017\03 Sitzungsprotokoll 2017" & "\" & " _
Betriebsratsprotokoll_" & Format(NeuerName, "yyyy-mm-dd") & ".pdf"
Rem PDF-Datei erstellen
Worksheets("Protokoll").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False,  _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
With Application
'Rückgängig Beschleunigen:
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic 'Berechnung einschalten
End With
Worksheets("Protokoll").Protect 'Schutz setzen
End With
Application.ScreenUpdating = True 'Makro Anzeigen
End Sub

Anzeige
AW: Makro beschleunigen/Excel beschleunigen
26.06.2017 14:56:57
Martina
Leider auch kein Unterschied :-(
AW: Makro beschleunigen/Excel beschleunigen
26.06.2017 15:28:45
Robert
könnte es sein dass die pdf Erstellung solange dauert? evtl als exceldatei erstellen lassen?
AW: Makro beschleunigen/Excel beschleunigen
27.06.2017 08:08:27
Martina
Guten Morgen,
nein, die pdf Erstellung geht schnell.
Ich habe das Makro gerade Schritt für Schritt nochmal durchlaufen lassen: das Problem scheint an der Formatierung zu liegen. Alles andere geht schnell.
Wenn ich den Block
    'Formatierung ändern
Worksheets("Anwesenheitsliste").Select
Columns("L:AM").Select
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
weglasse läuft das Makro in ein paar Sekunden durch - mit diesem Block läuft es bis zu 4 Minuten.
Wahnsinn :-)
Anzeige
AW: Makro beschleunigen/Excel beschleunigen
27.06.2017 09:04:39
Robert
'Formatierung ändern
Worksheets("Anwesenheitsliste").Select
Application.ScreenUpdating = False
Columns("L:AM").Select
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
Application.ScreenUpdating = true
End With
Anzeige
AW: Makro beschleunigen/Excel beschleunigen
27.06.2017 10:02:46
Werner
Hallo Martina,
als erstes würde ich mal die Selects weglassen. Dann stellt sich die Frage, ob du tatsächlich auch diagonale Linien in deinen Zellen hast? Wenn nein, dann kann man das im Code weg lassen. Wenn keine diagonalen Linien da sind, dann braucht man die auch nicht zu entfernen.
Weitere Möglichkeit zu beschleunigen wäre dann noch den Code nicht auf die ganzen Spalten anzuwenden, sondern nur auf den Bereich, der auch tatsächlich mit Daten/Rahmen belegt ist. Dazu müsste man die letzte belegte Zelle ermitteln.
Hierzu müsste ich aber wissen, in welcher Spalte dieser Wert zu ermitteln ist. Sprich: Welche der Spalten hat immer den letzten Wert im Bereich.
Hier mal der Code ohne Select und ohne die Entfernung von diagonalen Linien. Ob es was bringt musst du mal testen.
'Formatierung ändern
With Worksheets("Anwesenheitsliste").Columns("L:AM")
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Worksheets("Anwesenheitsliste").Columns("L:AM").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Gruß Werner
Anzeige
AW: Makro beschleunigen/Excel beschleunigen
27.06.2017 12:40:20
Martina
Hallo,
super, das funktioniert deutlich schneller. Ich habe aber auch anstatt die Spalten jetzt nur einen bestimmten Bereich genommen, in dem die Formatierung angepasst wird (großzügig bemessen, so dass auf jeden Fall meine kopierten Daten mit drin sind).
Vielen Dank für die Hilfe.
Martina
Gerne u. Danke für die Rückmeldung.
27.06.2017 12:43:57
Werner
Hallo Martina,
übrigens hast du noch mehr Select Anweisungen im Code die man mit Sichrheit nicht braucht.
Gruß Werner

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige