Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
25.04.2024 21:06:05
Duplikate entfernen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1744to1748
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
1744to1748
1744to1748
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Ausführung Makro beschleunigen

Ausführung Makro beschleunigen
06.03.2020 15:28:19
Enno123
Hallo zusammen
Ich habe mit meinen Kenntnissen zwar erreicht, was ich inhaltlich möchte. Nun stelle ich aber fest, dass das Makro in dieser Form bei der Ausführung merklich länger Zeit in Anspruch nimmt als ich mir erhofft habe.
Kann mir jemand einen Tipp geben, wie ich den fett markierten Teil von meinem Code - ich vermute, dort liegt der Hund irgendwie begraben - eventuell umbauen kann, um die Ausführung zu beschleunigen? Ich komme da alleine leider nicht weiter.
Vielen Dank
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim wbZiel As Workbook, wbQuelle As Workbook
Set wbZiel = ThisWorkbook
Dim strPfadQuelle As String
strPfadQuelle = "C:\Users\xyz\Desktop\TESTfiles Excel VBA\Testfile.xlsx"
Dim wsZiel As String, wsQuelle As String
wsZiel = "Projekte"
wbZiel.Sheets(wsZiel).Unprotect Password:="XYZ"
Workbooks.Open (strPfadQuelle)
Set wbQuelle = ActiveWorkbook
wsQuelle = "Name"
wbQuelle.Sheets(wsQuelle).Range("B8:BP521").AutoFilter
wbQuelle.Sheets(wsQuelle).Range("B8:BP521").AutoFilter 2, "1"
wbZiel.Sheets(wsZiel).Range("B58:BF" & Rows.Count).ClearContents
wbQuelle.Sheets(wsQuelle).Range("B10:B" & Rows.Count).Copy
wbZiel.Sheets(wsZiel).Range("B58").PasteSpecial Paste:=xlPasteValues
wbQuelle.Sheets(wsQuelle).Range("C10:C" & Rows.Count).Copy
wbZiel.Sheets(wsZiel).Range("C58").PasteSpecial Paste:=xlPasteValues
wbQuelle.Sheets(wsQuelle).Range("N10:BN" & Rows.Count).Copy
wbZiel.Sheets(wsZiel).Range("F58").PasteSpecial Paste:=xlPasteValues
Application.DisplayAlerts = False
wbQuelle.Close SaveChanges:=False
wbZiel.Sheets(wsZiel).Range("a56").Value = "letzte Änderung: " & Now
wbZiel.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
wbZiel.Sheets(wsZiel).Protect Password:="XYZ"
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ausführung Makro beschleunigen
07.03.2020 07:07:58
fcs
Hallo Enno,
häufig hilft es zusätzlich zur Deaktivierung der Bildschirmaktualisierung auch den Berechnungsmodus vorübergehend auf manuell zu setzen - insbesondere dann wenn in der Zieltabelle Formeln vorhanden sind, die die eingefügten Daten verarbeiten.
Falls in den Dateien Ereignismakros integriert sind, dann sollten dies ebenfalls vorübergehend deaktiviert werden.
Du kopierst immer jeweils Zellenbereich bis zur letzten Zeile des Tabellenblatts.
Effektiver ist es die etzte benutzte Zeile zu ermittel und nur die Zellen bis zu dieser Zeile zu kopieren.
LG
Franz 
Private Sub Workbook_Open()
Dim wbZiel As Workbook, wbQuelle As Workbook
Dim strPfadQuelle As String
Dim wsZiel As String, wsQuelle As String
Dim StatusCalc As Long
Dim zeiQuelle As Long
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
'    .EnableEvents = False 'Falls in den Dateien Ereignismakros verwendet werden
End With
Set wbZiel = ThisWorkbook
strPfadQuelle = "C:\Users\xyz\Desktop\TESTfiles Excel VBA\Testfile.xlsx"
wsZiel = "Projekte"
wbZiel.Sheets(wsZiel).Unprotect Password:="XYZ"
Workbooks.Open (strPfadQuelle)
Set wbQuelle = ActiveWorkbook
wsQuelle = "Name"
wbQuelle.Sheets(wsQuelle).Range("B8:BP521").AutoFilter
wbQuelle.Sheets(wsQuelle).Range("B8:BP521").AutoFilter 2, "1"
'letzte benutzte Zeile in Quelltabelle
With wbQuelle.Sheets(wsQuelle).UsedRange
zeiQuelle = .Row + .Rows.Count - 1
End With
wbZiel.Sheets(wsZiel).Range("B58:BF" & Rows.Count).ClearContents
wbQuelle.Sheets(wsQuelle).Range("B10:B" & zeiQuelle).Copy
wbZiel.Sheets(wsZiel).Range("B58").PasteSpecial Paste:=xlPasteValues
wbQuelle.Sheets(wsQuelle).Range("C10:C" & zeiQuelle).Copy
wbZiel.Sheets(wsZiel).Range("C58").PasteSpecial Paste:=xlPasteValues
wbQuelle.Sheets(wsQuelle).Range("N10:BN" & zeiQuelle).Copy
wbZiel.Sheets(wsZiel).Range("F58").PasteSpecial Paste:=xlPasteValues
Application.DisplayAlerts = False
wbQuelle.Close SaveChanges:=False
wbZiel.Sheets(wsZiel).Range("a56").Value = "letzte Änderung: " & Now
Application.Calculate
wbZiel.Save
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = StatusCalc
.EnableEvents = True
End With
wbZiel.Sheets(wsZiel).Protect Password:="XYZ"
End Sub

Anzeige
AW: Ausführung Makro beschleunigen
09.03.2020 10:36:37
Enno123
Hallo Franz
Vielen Dank für deine Hilfe. Deine Anpassungen kann ich soweit nachvollziehen, aber leider stoppt dein Vorschlag bei der fett markierten Codezeile
zeiQuelle = .Row + .Rows.Count - 1
mit der Fehlermeldung "Objekt erforderlich". Kannst du mir sagen woran das liegt?
Gruss
Enno
Private Sub Workbook_Open()
Dim wbZiel As Workbook, wbQuelle As Workbook
Dim strPfadQuelle As String
Dim wsZiel As String, wsQuelle As String
Dim StatusCalc As Long
Dim zeiQuelle As Long
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
'    .EnableEvents = False 'Falls in den Dateien Ereignismakros verwendet werden
End With
Set wbZiel = ThisWorkbook
strPfadQuelle = "C:\Users\xyz\Desktop\TESTfiles Excel VBA\Testfile.xlsx"
wsZiel = "Projekte"
wbZiel.Sheets(wsZiel).Unprotect Password:="XYZ"
Workbooks.Open (strPfadQuelle)
Set wbQuelle = ActiveWorkbook
wsQuelle = "Name"
wbQuelle.Sheets(wsQuelle).Range("B8:BP521").AutoFilter
wbQuelle.Sheets(wsQuelle).Range("B8:BP521").AutoFilter 2, "1"
'letzte benutzte Zeile in Quelltabelle
With wbQuelle.Sheets(wsQuelle).UsedRange
zeiQuelle = .Row + .Rows.Count - 1
End With
wbZiel.Sheets(wsZiel).Range("B58:BF" & Rows.Count).ClearContents
wbQuelle.Sheets(wsQuelle).Range("B10:B" & zeiQuelle).Copy
wbZiel.Sheets(wsZiel).Range("B58").PasteSpecial Paste:=xlPasteValues
wbQuelle.Sheets(wsQuelle).Range("C10:C" & zeiQuelle).Copy
wbZiel.Sheets(wsZiel).Range("C58").PasteSpecial Paste:=xlPasteValues
wbQuelle.Sheets(wsQuelle).Range("N10:BN" & zeiQuelle).Copy
wbZiel.Sheets(wsZiel).Range("F58").PasteSpecial Paste:=xlPasteValues
Application.DisplayAlerts = False
wbQuelle.Close SaveChanges:=False
wbZiel.Sheets(wsZiel).Range("a56").Value = "letzte Änderung: " & Now
Application.Calculate
wbZiel.Save
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = StatusCalc
.EnableEvents = True
End With
wbZiel.Sheets(wsZiel).Protect Password:="XYZ"
End Sub

Anzeige
AW: Ausführung Makro beschleunigen
09.03.2020 14:33:06
fcs
Hallo Enno,
nachvollziehen kann ich den Fehler nicht.
Ich hab jetzt mal die Variable wsQuelle anders deklariert und statt des Namens das Tabellenblatt zugewiesen - ist auch die bessere Methode, wenn man das Tabellenblatt später wieder im Code verwenden möchte.
Eine zu öffnende Dati kann man auch direkt einer Objektvariablen zuweisen. Man muss nicht den Umweg über "ActiveWorkbook" gehen.
Evtl. funktioniert es so.
LG
Franz 
Private Sub Workbook_Open()
Dim wbZiel As Workbook, wbQuelle As Workbook
Dim strPfadQuelle As String
Dim wsZiel As String, wsQuelle As Worksheet
Dim StatusCalc As Long
Dim zeiQuelle As Long
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
'    .EnableEvents = False 'Falls in den Dateien Ereignismakros verwendet werden
End With
Set wbZiel = ThisWorkbook
strPfadQuelle = "C:\Users\xyz\Desktop\TESTfiles Excel VBA\Testfile.xlsx"
wsZiel = "Projekte"
wbZiel.Sheets(wsZiel).Unprotect Password:="XYZ"
'Quelldatei schreibgeschützt öffnen und der Variablen zuweisen
Set wbQuelle = Workbooks.Open(strPfadQuelle, ReadOnly:=True)
Set wsQuelle = wbQuelle.Worksheets("Name")
wsQuelle.Range("B8:BP521").AutoFilter
wsQuelle.Range("B8:BP521").AutoFilter 2, "1"
'letzte benutzte Zeile in Quelltabelle
With wsQuelle.UsedRange
zeiQuelle = .Row + .Rows.Count - 1
End With
wbZiel.Sheets(wsZiel).Range("B58:BF" & Rows.Count).ClearContents
wsQuelle.Range("B10:B" & zeiQuelle).Copy
wbZiel.Sheets(wsZiel).Range("B58").PasteSpecial Paste:=xlPasteValues
wsQuelle.Range("C10:C" & zeiQuelle).Copy
wbZiel.Sheets(wsZiel).Range("C58").PasteSpecial Paste:=xlPasteValues
wsQuelle.Range("N10:BN" & zeiQuelle).Copy
wbZiel.Sheets(wsZiel).Range("F58").PasteSpecial Paste:=xlPasteValues
Application.DisplayAlerts = False
wbQuelle.Close SaveChanges:=False
wbZiel.Sheets(wsZiel).Range("a56").Value = "letzte Änderung: " & Now
Application.Calculate
wbZiel.Save
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = StatusCalc
.EnableEvents = True
End With
wbZiel.Sheets(wsZiel).Protect Password:="XYZ"
End Sub

Anzeige
AW: Ausführung Makro beschleunigen
09.03.2020 15:11:57
Enno123
Hallo Franz
So, jetzt funktioniert es einwandfrei. Und läuft auch sehr viel schneller als mein eigener Versuch.
Vielen Dank
Gruss
Ingo

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige