XL File ohne Makro 5MB, mit VBA 35MB?
Chris
durch ein Makro vergrößert sich einen Datei massiv und ich verstehe nicht warum.
Zunächst sortiere ich einige Spalten um:
Sub MarketAxess_SpaltenAnpassen()
Application.ScreenUpdating = False
Worksheets("Market Axess").Activate
Worksheets("Market Axess").Columns("K:K").Cut
Worksheets("Market Axess").Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("J:J").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("D:D").Select
Selection.ClearContents
Columns("H:H").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("H:H").Select
Selection.Cut
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Columns("M:M").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
'Volumen mal 1000
Dim LastRowMarketAxess1 As Integer
LastRowMarketAxess1 = Worksheets("Market Axess").UsedRange.Rows.Count
For i = 1 To LastRowMarketAxess1
Worksheets("Market Axess").Range("E" & i).Value = Worksheets("Market Axess").Range("E" & _
_
i).Value * 1000
Next i
End Sub
Diese ausgeschnittenen Spalten werden doch nicht weiter gespeichert oder doch?
Dann folgt das eigentlich Makro, das aus drei Datensheets Zeileneinträge sucht. Die Schlüsselnamen werden für jedes Sheet in einer Namensliste eingegeben
Sub NurTabellenBlattNamen()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim ws As Worksheet
Dim wsname As String 'Name des Datenworksheets
Dim ws2name As String 'Name des Statistikworksheets
Dim nameRange As Range 'Liste der möglichen Firmennamen
Dim Namensvariante As Range 'Einzelne Firmennamenobjekte
'Mit Schleife die roten Worksheets finden
For Each ws In ThisWorkbook.Worksheets
If ws.Tab.ColorIndex = 3 Then
'Alte Daten löschen
ws.Range("A2:M65536").ClearContents
wsname = ws.Name
ws2name = wsname & "2"
'Liste definieren in der alle möglichen Firmennamenvarianten stehen
Set startnamerange = Worksheets(ws2name).Range("A80")
Set endnamerange = Worksheets(ws2name).Range("A90")
Set nameRange = Range(startnamerange, endnamerange)
For Each Namensvariante In nameRange
'Jetzt wurde ein Name aus der Firmennamenvariantenliste ausgewählt
'Anzahl der Zeilen in gelben Sheets finden die Daten enthalten
LastRowBBT = Worksheets("BBT").UsedRange.Rows.Count
LastRowMarketAxess = Worksheets("Market Axess").UsedRange.Rows.Count
LastRowTradeWeb = Worksheets("Trade Web").UsedRange.Rows.Count
'Letze Zeile im roten Datensheet finden
LastRowWSName = Worksheets(wsname).Range("B65536").End(xlUp).Row
'Jedes der drei gelben Datensheets durchlaufen
'1. BBT
For i = 2 To LastRowBBT
If Worksheets("BBT").Range("G" & i).Value = Namensvariante Then
Worksheets(wsname).Rows(LastRowWSName + 1).Value = Worksheets("BBT"). _
_
Rows(i).Value
LastRowWSName = Worksheets(wsname).Range("B65536").End(xlUp).Row
End If
Next i
'2. MarketAxess
For i = 2 To LastRowMarketAxess
If Worksheets("Market Axess").Range("G" & i).Value = Namensvariante _
Then
Worksheets(wsname).Rows(LastRowWSName + 1).Value = Worksheets(" _
Market Axess").Rows(i).Value
LastRowWSName = Worksheets(wsname).Range("B65536").End(xlUp).Row
End If
Next i
'3. Trade Web
For i = 2 To LastRowTradeWeb
If Worksheets("Trade Web").Range("G" & i).Value = Namensvariante Then
Worksheets(wsname).Rows(LastRowWSName + 1).Value = Worksheets("Trade _
_
Web").Rows(i).Value
LastRowWSName = Worksheets(wsname).Range("B65536").End(xlUp).Row
End If
Next i
Next Namensvariante
'Gesamten Datenblock eine Spalte nach rechts verschieben
Worksheets(wsname).Range("A2:L" & LastRowWSName).Cut
ActiveSheet.Paste Destination:=Worksheets(wsname).Range("B2:M" & LastRowWSName)
End If
Next ws
Call Datenkuerzeleinfuegen
End Sub
In den "gelben" Datensheets stehen einige Zeileneinträge (in einem Sheet etwa 20000), deswegen dauert es auch einige Zeit bis das Ergebnis kommt (15min), aber das ist nicht das Problem.
Zudem werden nur wenige der Zeilen in die entsprechenden roten Sheets kopiert, sodass nach dem Durchlauf des Makros nicht so viele Zellen mehr als vorher Daten enthalten - dennoch ist die Datei jetzt ca 7x so groß. Kann mir das bitte einer erklären?