AW: Zellen in Spalten einzeln mit Formeln füllen
11.02.2012 22:24:18
fcs
Hallo Werner,
so wie die Formeln aufebaut sind sind die Ergebnisse der Formeln nicht von einander abhängig. Alle Formeln benutzen nur Zellen aus den Spalten A bis D. Außerdem sind deine eingetragenen Formeln nicht ganz korrekt.
Ich glaube kaum, dass die Aktualisierung schneller geht, wenn du die Formeln zeilenweise einfügst.
Bei ca. 1600 Datenzeilen benötigt das Makro inklusive kopieren der Formeln, Neuberechnung und Formeln durch Werte ersetzen ca. 15 Sekunden (Excel 2007, mittel-schnelles Notebook).
Das 2. Makro, das zeilenweise die Formeln einfügt und neu berechnet benötigt etwa 2 bis 3 mal so lange.
Gruß
Franz
Sub FormelnMatrix_in_Werte()
Dim wks As Worksheet, ZL As Long, StatusCalc As Long
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wks = ActiveSheet
With wks
ZL = .Cells(.Rows.Count, 1).End(xlUp).Row
'Matrix-Formeln in Zeile 2 einfügen
.Range("E2").FormulaArray = _
"=LARGE(IF((R2C1:R" & ZL & "C1=RC[-4])*(R2C2:R" & ZL & "C2=RC[-3]),R2C4:R" _
& ZL & "C4),1)"
.Range("F2").FormulaArray = _
"=IF(ISERROR(LARGE(IF((R2C1:R" & ZL & "C1=RC[-5])*(R2C2:R" & ZL _
& "C2=RC[-4]),R2C4:R" & ZL & "C4),2)),"""",LARGE(IF((R2C1:R" & ZL _
& "C1=RC[-5])*(R2C2:R" & ZL & "C2=RC[-4]),R2C4:R" & ZL & "C4),2))"
.Range("G2").FormulaArray = _
"=IF(ISERROR(LARGE(IF((R2C1:R" & ZL & "C1=RC[-6])*(R2C2:R" & ZL _
& "C2=RC[-5]),R2C4:R" & ZL & "C4),3)),""no third party"",LARGE(IF((R2C1:R" _
& ZL & "C1=RC[-6])*(R2C2:R" & ZL & "C2=RC[-5]),R2C4:R" & ZL & "C4),3))"
'Zellen mit Formeln Zeile 2 in alle Zeilen der Spalten E bis G kopieren
.Range("E2:G2").Copy Destination:=wks.Range("E3:G" & ZL)
With .Range("E2:G" & ZL)
.Calculate
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End With
End With
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub
Sub FormelnMatrix_in_Werte_2()
Dim wks As Worksheet, ZL As Long, StatusCalc As Long, lngZ As Long
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wks = ActiveSheet
With wks
ZL = .Cells(.Rows.Count, 1).End(xlUp).Row
For lngZ = 2 To ZL
'Matrix-Formeln in Zeile einfügen
.Cells(lngZ, 5).FormulaArray = _
"=LARGE(IF((R2C1:R" & ZL & "C1=RC[-4])*(R2C2:R" & ZL & "C2=RC[-3]),R2C4:R" _
& ZL & "C4),1)"
.Cells(lngZ, 6).FormulaArray = _
"=IF(ISERROR(LARGE(IF((R2C1:R" & ZL & "C1=RC[-5])*(R2C2:R" & ZL _
& "C2=RC[-4]),R2C4:R" & ZL & "C4),2)),"""",LARGE(IF((R2C1:R" & ZL _
& "C1=RC[-5])*(R2C2:R" & ZL & "C2=RC[-4]),R2C4:R" & ZL & "C4),2))"
.Cells(lngZ, 7).FormulaArray = _
"=IF(ISERROR(LARGE(IF((R2C1:R" & ZL & "C1=RC[-6])*(R2C2:R" & ZL _
& "C2=RC[-5]),R2C4:R" & ZL & "C4),3)),""no third party"",LARGE(IF((R2C1:R" _
& ZL & "C1=RC[-6])*(R2C2:R" & ZL & "C2=RC[-5]),R2C4:R" & ZL & "C4),3))"
'Zellen mit Formeln berechnen und Inhalte durch Werte ersetzen
With .Range(.Cells(lngZ, 5), .Cells(lngZ, 7))
.Calculate
.Value = .Value
End With
Next lngZ
End With
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub