Hallo Peter,
Zitat:oder *.xlsm
Da ist nichts weg. Ich schrieb auch, dass ich ja nicht weiß ob sich Makros in der Datei befinden.
Gruß
Marcus
Hallo Marcus,
wenn Du ein Bedürfnis hast, das weiterzudiskutieren, dann bitte per PN.
Hallo es klappt nun, bis darauf dass bei automatischem einfügen die Berechnungen sehr lange brauchen oder Excel sich aufhängt.
Je nach Größe würde es sich anbieten, die Berechnungen der Formeln und das Screenupdating für die Zeit des kopierens zu deaktivieren.
Danach eben wieder an!
Bin gerade nur mit Handy drin, da kann Google oder andere gerne helfen:
With Application
.Screenupdate = False
.Calculate = Manual
End With
Wie gesagt, kenne ich nicht genau aus dem Kopf ;)
Hallöchen,
nicht
.Calculate = Manual
sondern
.Calculation = xlCalculationManual
Application.Calculate wäre die Methode zum Berechnen
Hallo Zusammen,
folgendes habe ich eingebaut:
Code:
Sub Berechnungen_ein()
Application.Calculation = xlCalculationAutomatic 'automat.Berechnung einschalten
Application.ScreenUpdating = True 'Bildschirmaktualisierung einschalten
End Sub
Code:
Sub Berechnungen_aus()
Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
Application.Calculation = xlCalculationManual 'automat.Berechnung ausschalten
End Sub
Ich füge 3 Dateien ein.
Manuell benötige ich 40 Sekunden.
Mit Makro 1 Minute und 47 Sekunden :(.
Das wäre mein Makro:
Code:
Sub Rohdaten_einfügen2()
Dim NeueDateipfad_CN41N As Variant
Dim Datei_CN41N As Workbook
Dim Range_CN41N As Range
Dim Letztezeile_CN41N As Long
Dim Letztespalte_CN41N As Long
Dim NeueDateipfad_Import2 As Variant
Dim Datei_Import2 As Workbook
Dim Range_Import2 As Range
Dim Letztezeile_Import2 As Long
Dim Letztespalte_Import2 As Long
Dim NeueDateipfad_CN43N As Variant
Dim Datei_CN43N As Workbook
Dim Range_CN43N As Range
Dim Letztezeile_CN43N As Long
Dim Letztespalte_CN43N As Long
Call Blattschutz_aus
Call Berechnungen_aus
MsgBox ("aktuelle Rohdaten CN41N auswählen")
NeueDateipfad_CN41N = Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.xlsx), *.xlsx", title:="b") ' Datei auswählen
If NeueDateipfad_CN41N = False Then MsgBox "Der Upgrade vorgang wurde abgebrochen!", vbInformation, "Information": Exit Sub ' bei Abbruch
MsgBox ("aktuelle Rohdaten Import_2 auswählen")
NeueDateipfad_Import2 = Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.xls), *.xls", title:="b") ' Datei auswählen
If NeueDateipfad_Import2 = False Then MsgBox "Der Upgrade vorgang wurde abgebrochen!", vbInformation, "Information": Exit Sub ' bei Abbruch
Call CN41N_Löschen
Call Import2_Löschen
Call Blattschutz_aus
If WorksheetFunction.CountA(ThisWorkbook.Sheets("Import_CN43N").Cells) = 0 Then
GoTo Line3
End If
a = MsgBox("Hat sich die PSP-Struktur geändert? (Bei Ja aktuelle CN43N-Datei benötigt)", vbYesNo)
If a = vbNo Then GoTo Line1 Else
GoTo Line3
Line3:
MsgBox ("aktuelle Rohdaten CN43N auswählen")
NeueDateipfad_CN43N = Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.xlsx), *.xlsx", title:="b") ' Datei auswählen
If NeueDateipfad_CN43N = False Then MsgBox "Der Upgrade vorgang wurde abgebrochen!", vbInformation, "Information": Exit Sub ' bei Abbruch
Call CN43N_Löschen
Call Blattschutz_aus
Line1:
Set Datei_CN41N = Workbooks.Open(NeueDateipfad_CN41N, ReadOnly:=True) ' Datei öffnen
With Sheets("Tabelle1")
LetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
LetzteSpalte = Cells(1, Columns.Count).End(xlToLeft).Column
Set CN41N_Range = Range(Cells(1, 1), Cells(LetzteZeile, LetzteSpalte))
CN41N_Range.Select
CN41N_Range.Copy
' hier anpassen
End With
ThisWorkbook.Sheets("Import_CN41N").Range("a42").PasteSpecial Paste:=xlPasteValues ' hier anpassen
Application.CutCopyMode = False
Datei_CN41N.Close
Set Datei_Import2 = Workbooks.Open(NeueDateipfad_Import2, ReadOnly:=True) ' Datei öffnen
'MsgBox (Left(Datei_Import2.name, Len(Datei_Import2.name) - 4))
'With Sheets("20200109_Import_2_CC-160250")
With Sheets(Left(Datei_Import2.name, Len(Datei_Import2.name) - 4))
LetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
LetzteSpalte = Cells(4, Columns.Count).End(xlToLeft).Column
Set Import2_Range = Range(Cells(1, 1), Cells(LetzteZeile, LetzteSpalte))
Import2_Range.Select
Import2_Range.Copy
' hier anpassen
End With
ThisWorkbook.Sheets("Import_2").Range("a1").PasteSpecial Paste:=xlPasteValues ' hier anpassen
Application.CutCopyMode = False
Datei_Import2.Close
If WorksheetFunction.CountA(ThisWorkbook.Sheets("Import_CN43N").Cells) = 0 Then
GoTo Line4
End If
If a = vbNo Then GoTo Line2 Else
GoTo Line4
Line4:
Set Datei_CN43N = Workbooks.Open(NeueDateipfad_CN43N, ReadOnly:=True) ' Datei öffnen
With Sheets("Sheet1")
LetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
LetzteSpalte = Cells(1, Columns.Count).End(xlToLeft).Column
Set CN43N_Range = Range(Cells(1, 1), Cells(LetzteZeile, LetzteSpalte))
CN43N_Range.Select
CN43N_Range.Copy
' hier anpassen
End With
ThisWorkbook.Sheets("Import_CN43N").Range("a1").PasteSpecial Paste:=xlPasteValues ' hier anpassen
Application.CutCopyMode = False
Datei_CN43N.Close
Line2:
Call Blattschutz_ein
Call Berechnungen_ein
End Sub
Also wenn ich die automatischen Berechnungen ausschalte geht es sehr schnell.
Mit automatischen Berechnungen dauert es 1 Minute und 47 Sekunden.
Manuelles einfügen mit automatischen Berechnungen dauert aber 40 Sekunden.
Macht doch gar keinen Sinn dass die manuelle Variante schneller geht, wenn die Geschwindigkeit ja nur von den Berechnungen abhängt.
Hallöchen,
eine Frage wäre, ob Du manuell 100% genau so vorgehst wie automatisch. Hast Du in beiden Varianten alle Dateien geschlossen, …
Unabhängig davon mal ein paar erste Hinweise zu Deinem Code:
With Sheets("Tabelle1")
LetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
LetzteSpalte = Cells(1, Columns.Count).End(xlToLeft).Column
Set CN41N_Range = Range(Cells(1, 1), Cells(LetzteZeile, LetzteSpalte))
CN41N_Range.Select
CN41N_Range.Copy
' hier anpassen
End With
Was hast Du hier mit dem With vor? Du nutzt es gar nicht. Und wenn, dann wäre die Frage, warum Du die letzte Zeile vom aktiven Sheet holst und den Rest? gerne von Tabelle1 hättest. Wenn wirklich alles von Tabelle1 kommen soll, egal welches Blatt aktiv ist, und Du die Variable CN41_Range nur beim Kopieren verwendest und sie daher nicht nötig ist, könnte der Code so aussehen:
With Sheets("Tabelle1")
LetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
LetzteSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, 1), .Cells(LetzteZeile, LetzteSpalte)).Copy
' hier anpassen
End With
Also von der Geschwindigkeit ist es jetzt ok. Aber es tritt nun ein Fehler auf. Ich habe einige Summewenns Formeln. Ein paar funktioniere nicht sobald ich den automatischen Dateneinzug mache. Aber bei manuellem schon. Es sind auch nur ein paar Formeln die nicht funktionieren obwohl zahlreiche ähnliche funktionierende Formeln gibt. Die Berechnungen sind offensichtlich auch an.
hmmm
Ok es liegt an der .XLS Datei. Das Funktioniert zwar alles aber sobald ich die Datei verwende funktionieren die eben erwähnten Formeln nicht mehr. Wenn ich die .XLS Datei zu einer .XLSX kurz ummodifiziere und die Formel für .XLSX anpasse dann klappt es ganz normal. Ist aber blöd, da die Datei eigentlich primär als XLS erstellt wird und es anders gar nicht geht.