Microsoft Excel

Herbers Excel/VBA-Archiv

Zellen in Spalten einzeln mit Formeln füllen | Herbers Excel-Forum


Betrifft: Zellen in Spalten einzeln mit Formeln füllen von: Werner
Geschrieben am: 11.02.2012 17:53:05

Hallo,
ich habe eine Tabelle (viele Datensätze), die in einigen Spalten mit Matrixformeln berechnet wird. Dementsprechend lange dauert es dann, wenn eine Neuberechnung anbeschubst wird.

Deswegen dachte ich, man könnte die Formeln jeweils nur um eine Zelle nach unten "ziehen" und dann die darüber liegende Zelle gleich wieder zurück in einen Wert umwandeln. Wenn die Spalte komplett berechnet ist, sollte die nächste Spalte dran kommen. Es sind insgesamt 4 Spalten. Die Werte in den jeweiligen, berechneten Zellen hängen voneinander ab, das wird auch der Grund sein, warum die Berechnung so lange dauert.

Könnt Ihr mir dabei helfen?

Hier mein jämmerlicher Versuch, funktioniert natürlich nicht, nicht mal für eine Spalte.

https://www.herber.de/bbs/user/78863.xls

Danke, für Eure Hilfe

Gruß

Werner

  

Betrifft: AW: Zellen in Spalten einzeln mit Formeln füllen von: fcs
Geschrieben am: 11.02.2012 22:24:18

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



  

Betrifft: AW: Zellen in Spalten einzeln mit Formeln füllen von: Werner
Geschrieben am: 12.02.2012 06:54:47

Hallo Franz,
vielen Dank für Deinen Beitrag!
Es ist ja eine Beispielarbeitsmappe mit ein paar Matrixformeln, das Original kann ich nicht posten. In Wirklichkeit sind die Formeln von den Ergebnissen anderer berechneter Formeln abhängig.

Die Idee war, die Formeln zellenweise zu kopieren, nicht zeilenweise.

Eines würde mich noch interessieren, wieso sind diese Formeln nicht ganz korrekt?

Danke, für den Code, ich werde ihn gleich testen.

Gruß
Werner


  

Betrifft: AW: Zellen in Spalten einzeln mit Formeln füllen von: Werner
Geschrieben am: 12.02.2012 07:14:23

Hallo,
der Code funktioniert einwandfrei. Vielen Dank!

Werner


  

Betrifft: AW: Zellen in Spalten einzeln mit Formeln füllen von: Werner
Geschrieben am: 12.02.2012 06:58:13

Hallo Franz,
ich weiß jetzt, was Du meinst: Ich müsste in den Formeln die Bereiche in absolute Bezüge umwandeln, damit der komplette Bereich erfasst wird. Wie gesagt, das war nur eine Beispielmappe.


Gruß
Werner


Beiträge aus den Excel-Beispielen zum Thema "Zellen in Spalten einzeln mit Formeln füllen"