Problem - Exceldatei stürzt manchmal ab
19.03.2014 10:00:03
Stefan
ich habe in den letzten Wochen eine Auswertungsdatei geschrieben, die leider manchmal abstürzt. Bei einem Laptop hat sie häufiger Problem. Bei einem anderen Stand-PC habe ich das ganze jetzt mal überprüft. Hier kann ich das ganze Makro so etwa 3-4 mal laufen lassen, danach folgt ein Fehler beim refreshen den Pivottables.
Es wäre super, wenn mal jemand drüber schaut und sagen könnte wo da noch was verbessert werden könnte. Ist da was offensichtliches? Der Fehler scheint immer zu passieren, wenn die Pivtotables aktualisiert werden. Meiner Meinung nach passiert das aber nicht immer beim gleichen Arbeitsblatt. Eine mögliche Fehlerursache: Ich habe teilweise die Pivottbales kopiert und auf das nächste Auswertungsblatt eingefügt, dort teilweise angepasst. Hat er eventuell Probleme, weil die Pivottbales auf den einzelnen BLätter nicht ganz "eindeutig" sind?
Es wäre echt eine super Hilfe! Vielen Dank!
Sub ImportierennachExcel()
'Importiert Daten aus einem anderen Excelfile ins Tabellenblatt Daten Import,liest die Daten _
des Tabellenblatts Daten Import aus, fügt sie in eine bestimmte Spaltenreihenfolge im Blatt _
MASTER ein und aktualisiert die PivotTabelle in den Auswertungsblättern
'Definition der Variablen
Dim SpalteZiel As Integer, SpalteQuelle As Integer, rngSpalte As Range
Dim WsQuelle As Worksheet, wsZiel As Worksheet
Dim wsAuswertungmonthly_range As Worksheet, wsAuswertungmonthly_lifetime As Worksheet
Dim wsAuswertungquarterly_lifetime As Worksheet, wsAuswertungquarterly_range As Worksheet
Dim wsAuswertunggateway As Worksheet, wsAuswertungaligned As Worksheet
Dim pt As PivotTable
Dim Ziel As Workbook
Dim varDatei As Variant
'Definition der Tabellennamen
Set WsQuelle = Sheets("Daten Import")
Set wsZiel = Sheets("MASTER")
Set wsAuswertungmonthly_range = Sheets("monthly_range")
Set wsAuswertungmonthly_lifetime = Sheets("monthly_lifetime")
Set wsAuswertungquarterly_range = Sheets("quarterly_range")
Set wsAuswertungquarterly_lifetime = Sheets("quarterly_lifetime")
Set wsAuswertunggateway = Sheets("gateway")
Set wsAuswertungaligned = Sheets("aligned")
Set Ziel = ThisWorkbook 'für Excel Zwischenspeicherung
'Leert die Spalten im Master-Tabellenblatt für das Einfügen der neuen Daten (damit keine "alten" _
_
Daten mit in die Auswertung rutschen)
'wsZiel.Range("K3:K10000").ClearContents
'wsZiel.Range("M3:M10000").ClearContents
wsZiel.Range("A3:BB10000").ClearContents
'Application.Dialogs(xlDialogOpen).Show 'öffnet Quelldatei durch Pop-up-Fenster
varDatei = Application.GetOpenFilename
If varDatei = False Then
Exit Sub 'wenn auf Abbruch geklickt wird, stoppt das ganze Skript, sonst wird ausgewählte Datei _
_
geöffnet
Else
Workbooks.Open Filename:=varDatei
End If
Worksheets(1).Range("1:65535").Copy 'kopiere alles aus dem geöffneten RPlan-Excelfile in _
Zwischenablage um es in der Zieldatei im Blatt RPLAN Export einzusetzen
Ziel.Sheets("Daten Import").Activate 'wechselt zur Zieldatei zum Blatt RPLAN Export zurück
Ziel.Sheets("Daten Import").Range("1:65535").PasteSpecial _
Paste:=xlPasteValues
Application.CutCopyMode = False 'setzt Zwischenablage in Blatt ein
Sheets("RPLAN Export").Cells(1, 1).Select 'zeigt Blatt RPLAN Export an
'Schleife über alle Spalten der Quelle
For SpalteQuelle = 1 To WsQuelle.UsedRange.Columns.Count + WsQuelle.UsedRange.Column - 1
'Spalte im WsZiel suchen, es werden die Daten aus RPLAN Export ausgelesen
Set rngSpalte = wsZiel.Rows(1).Find(WsQuelle.Cells(1, SpalteQuelle).Value, lookat:= _
xlWhole, LookIn:=xlValues)
'was gefunden`?
If Not rngSpalte Is Nothing Then
'Spaltennummer auslesen
SpalteZiel = rngSpalte.Column
'einsetzen der Daten in die MASTER-Spaltenreihenfolge
Intersect(WsQuelle.Columns(SpalteQuelle), WsQuelle.UsedRange).Copy Destination:=wsZiel. _
_
Cells(1, SpalteZiel)
End If
Next
'zieht die Formeln in den Berechnungsspalten (duration [d], testcost [k] und platform) bis in _
_
die letzte gefüllte Zeile betrachtet in Spalte B (Name des Tests)
wsZiel.Range("K2:K" & wsZiel.Cells(Rows.Count, 2).End(xlUp).Row).FillDown
wsZiel.Range("M2:M" & wsZiel.Cells(Rows.Count, 2).End(xlUp).Row).FillDown
wsZiel.Range("AB2:AB" & wsZiel.Cells(Rows.Count, 2).End(xlUp).Row).FillDown
wsZiel.Range("AM2:AM" & wsZiel.Cells(Rows.Count, 2).End(xlUp).Row).FillDown
'Ändert das Format für die Spalten Start und Finish in die Datumsangabe
wsZiel.Range("H2:H" & wsZiel.Cells(Rows.Count, 2).End(xlUp).Row).NumberFormat = "dd.mm.yyyy"
wsZiel.Range("I2:I" & wsZiel.Cells(Rows.Count, 2).End(xlUp).Row).NumberFormat = "dd.mm.yyyy"
wsZiel.Range("AQ2:AQ" & wsZiel.Cells(Rows.Count, 2).End(xlUp).Row).NumberFormat = "dd.mm.yyyy"
wsZiel.Range("AR2:AR" & wsZiel.Cells(Rows.Count, 2).End(xlUp).Row).NumberFormat = "dd.mm.yyyy"
'aktualisiert die PivotTabellen in den Auswertungs-Arbeitsblättern
For Each pt In wsAuswertungmonthly_range.PivotTables
pt.RefreshTable
Next
For Each pt In wsAuswertungmonthly_lifetime.PivotTables
pt.RefreshTable
Next
For Each pt In wsAuswertungquarterly_range.PivotTables
pt.RefreshTable
Next
For Each pt In wsAuswertungquarterly_lifetime.PivotTables
pt.RefreshTable
Next
For Each pt In wsAuswertunggateway.PivotTables
pt.RefreshTable
Next
For Each pt In wsAuswertungaligned.PivotTables
pt.RefreshTable
Next
'fügt das Importdatum auf jedes Pivottable Arbeitsblatt
wsAuswertungmonthly_range.Cells(6, 2).Value = "Importdate: " & Date
wsAuswertungmonthly_lifetime.Cells(6, 2).Value = "Importdate: " & Date
wsAuswertungquarterly_range.Cells(6, 2).Value = "Importdate: " & Date
wsAuswertungquarterly_lifetime.Cells(6, 2).Value = "Importdate: " & Date
wsAuswertunggateway.Cells(6, 2).Value = "Importdate: " & Date
wsAuswertungaligned.Cells(6, 2).Value = "Importdate: " & Date
End Sub