Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1148to1152
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
SaveAs Datei zu gross
Detlef
Hallo zusammen,
mit folgendem Code erstelle ich Einzeldateien aus einer ca. 20 MB xls.
Sub procBD_Datei_erstellen()
    Dim strFormKopSP As String
    Dim intFormKopZE As Integer
    Dim intFormKopZEleer As Integer
    Dim intanzZeilen As Integer
    Dim AktWBook As String
    Dim strSERVER As String
    Dim strHIST As String
    Dim strAKTUDAT As String
    Dim strAKTUMONAT As String

    Dim wbkOrig As Object
    Dim wbkTemp As Object
    
    On Error Resume Next
    
    Application.Calculation = xlManual
    Application.DisplayAlerts = False
            
    verz = ActiveWorkbook.Path
    
    Set wbkOrig = ThisWorkbook

    wbkOrig.Activate
    wbkOrig.Worksheets("PARA").Select
    Range("A2").Select
    strVWS = Cells(ActiveCell.Row, ActiveCell.Column).Value
    strSERVER = Cells(ActiveCell.Row, ActiveCell.Column + 1).Value
    strHIST = Range("rP1.HIST").Value
    strAKTUDAT = Range("rP1.AKTUDAT").Value
    strAKTUMONAT = Mid(Range("rP1.AKTUMONAT").Value, 5, 2)

    While strVWS <> ""
        Workbooks.Open Filename:=verz + "\DATENSAMMLUNG_LEER.xls"
        Set wbkTemp = Workbooks("DATENSAMMLUNG_LEER.xls")
        
        'Inhalt OriginalSeite kopieren 
        wbkOrig.Activate
        wbkOrig.Worksheets("Import 1").Select
        Selection.AutoFilter Field:=6, Criteria1:=strVWS

        If Range("rP1.FilterErgebnis") > 2 Then
            Range("rI1.Daten").Select
            Selection.Copy
    
            'Inhalt in TempDatei einfügen 
            wbkTemp.Activate
            wbkTemp.Worksheets("Daten 1").Select
            Range("D3").Select
    
            ActiveSheet.Paste
        
            '***Formelbereich dynamisch anpassen 
            Range("rD1.Knoten01").Select
            
            strFormKopSP = "D:D"        '***das ist die Leitspalte ohne Formel 
            intFormKopZE = 3            '***da steht die zu kopierende Formel 
            intFormKopZEleer = 0        '***Anzahl Leerzeilen über Leitspalte 
            procFormelnNachUntenFüllen strFormKopSP, intFormKopZE, intFormKopZEleer
            
            Range("rP1.AKTUDAT").Value = strAKTUDAT
'            Range("rL1.MonateAusw_2").Value = Val(strAKTUMONAT) - 1 
        
            Calculate
            
            Call procUnikate
        
            '***Formelbereich dynamisch anpassen 
            Range("rF1.Knoten01").Select
        
            strFormKopSP = "J:J"        '***das ist die Leitspalte ohne Formel 
            intFormKopZE = 23            '***da steht die zu kopierende Formel 
            intFormKopZEleer = 11        '***Anzahl Leerzeilen über Leitspalte 
            procFormelnNachUntenFüllen strFormKopSP, intFormKopZE, intFormKopZEleer
            
            Application.Calculation = xlAutomatic
                        
            '***Spalten in Werte wandeln 
            Range("rF1.Daten_Namen").Formula = Range("rF1.Daten_Namen").Value
    
            procTabelleSchutz
            procTabelleSicherAusblenden

            '***jetzt speichern 
'            Kill strSERVER + "*.xls" 
'            ActiveWorkbook.SaveAs Filename:=strSERVER + strHIST + ".xls" 
            ActiveWorkbook.SaveAs Filename:=verz + "\" + strVWS + "_aktuStand" + strHIST + ".xls"
            ActiveWorkbook.Close
            Application.Calculation = xlManual
            
            '***nächste Einheit 
            Set wbkTemp = Nothing
            wbkOrig.Worksheets("PARA").Select
            ActiveCell.Offset(1, 0).Activate
            strVWS = Cells(ActiveCell.Row, ActiveCell.Column).Value
            strSERVER = Cells(ActiveCell.Row, ActiveCell.Column + 1).Value
        
        Else
        
            '***nächste Einheit 
            Set wbkTemp = Nothing
            wbkOrig.Worksheets("PARA").Select
            ActiveCell.Offset(1, 0).Activate
            strVWS = Cells(ActiveCell.Row, ActiveCell.Column).Value
            strSERVER = Cells(ActiveCell.Row, ActiveCell.Column + 1).Value
            
        End If
    Wend
    Application.DisplayAlerts = False
        
End Sub
Nach der Speicherung hat die Einzeldatei z.B. eine Größe von 1.653.760. Wenn ich nun diese Datei manuell öffne und wieder speichere kommt eine Größe von 806.912.
Das liegt auch nicht an diesem Ablauf. Das tritt bei allen ähnlichen auf. Gibt es beim ActiveWorkbook.SaveAs noch weitere Parameter die die Größe beieinflussen? Wenn ich das mit dem Recorder aufzeichne, ergeben sich auch keine weiteren Erkenntnisse.
Wo liegt der Fehler im Modul bzw. wie kann man das optimieren?
Gruß Detlef

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: SaveAs Datei zu gross
07.04.2010 14:08:05
Klaus-Dieter
Hallo Detlef,
ich kann mir nicht vorstellen, dass über die Speicherung die größe der Datei beeinflusst wird. In deinem Quelltext sehe ich aber das da teilweise mit kompletten Spalten gearbeitet wird. Da würde ich mal ansetzen.
Viele Grüße Klaus-Dieter

Online-Excel
AW: SaveAs Datei zu gross
07.04.2010 15:02:46
Detlef
Hallo Klaus-Dieter,
da wo ich auf ganze Spalten gehe, werden automatisch die zellen ermittelt, die mit Formeln gefüllt werden müssen. Hier der entsprechende Quelltext.
Sub procFormelnNachUntenFüllen(strFormKopSP As String, intFormKopZE As Integer, intFormKopZEleer As Integer)
    Dim lngZeilen As Long
    Dim IntSpalte As Integer
    
    lngZeilen = Application.WorksheetFunction.CountA _
    (ActiveSheet.Columns(strFormKopSP)) + intFormKopZEleer
    
    For IntSpalte = 1 To ActiveSheet.UsedRange.Columns.Count
    
    If Cells(intFormKopZE, IntSpalte).HasFormula Then
        Cells(intFormKopZE, IntSpalte).AutoFill Destination:= _
        Range(Cells(intFormKopZE, IntSpalte), Cells(lngZeilen, _
            IntSpalte)), Type:=xlFillDefault
    End If
    
    Next IntSpalte
End Sub
Es ist wirklich so, dass die Datei nach SaveAS fast doppelt so gross ist. Danach öffne ich einfach nur die Datei manuell und speichere wieder. Und dann hat sie sich um die Hälfte reduziert.
Gruß Detlef
Anzeige
AW: SaveAs Datei zu gross
07.04.2010 16:26:16
Andi
Hi Detlef,
Application.calculation. Nur wo nötig ausführen, und sonst wieder sofort deaktivieren.
Immer wenn ein Ereignis angestupst wird, wird die Application.calculation angestossen, wenn diese natürlich aktiv bzw. enabeld ist.
Frisst beim Datenschupsen viel Performance bzw. belastet den MEM unnötig. In dem Zusammenhang werden evtl. Mülldaten mitgespeichert. Ist eine Vermutung, ansonsten keine Gewährleistung.
Gruß Andi
PS Das bekannte Modul GetMoreSpeed sagt schon viel aus.
AW: SaveAs Datei zu gross
08.04.2010 15:39:40
Detlef
Hallo Andi,
leider bringt GetMoreSpeed an dieser Stelle auch nichts, läuft zwar deutlich schneller, aber die Dateigröße bleibt unverändert. Das ist schon echt ärgerlich. Wenn ich nach Erstellen meiner Dateien einfach nur mit Workbooks.Open und ActiveWorkbook.Save per Schleife alle Dateien durchspeichere, sind sie nur noch halb so groß.
Also wird sicherlich Datenmüll mitgespeichert. Ich lass die Frage nochmal offen. Vielleicht hat noch jemand eine Idee.
Ich habe bereits die Zwischenablage geprüft. Sie ist vorm Speichern leer. Alle leeren Zeilen und Spalten habe ich gelöscht. Auch Application.CutCopyMode = False hilft nicht.
Gruß Detlef
Anzeige
AW: SaveAs Datei zu gross
08.04.2010 21:53:08
Uduuh
Hallo,
evtl. hilft es, vor dem Speichern alle leeren Zeilen und Spalten zu löschen.
Gruß aus'm Pott
Udo
http://www.excelerator.de
AW: SaveAs Datei zu gross
09.04.2010 13:14:45
Detlef
Hallo Uduuh,
nein, leider nicht. Das hatte ich schon versucht (sh. meinen letzten Absatz).
Gruß Detlef

26 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige