Zellbezug ändert sich bei Kopieren
21.03.2022 14:36:18
Sabine
ich habe vor einiger Zeit einen Code gepostet der dann auch funktionierte - dachte ich zumindest.
Leider kann ich die Datei nicht hochladen, da sie trotz Kürzung zu groß ist (knapp 1 MB).
Folgendes: Spalte A bis J sind Werte aus einem Datenabruf.
Ab Spalte K formeln, die auf den Daten aufbauen.
Ab Spalte K gehören die Formeln nicht mehr zur Tabelle, da sonst die Dateigröße explodiert und die Datei unglaublich langsam wird.
Das Makro schaut nun, ob die Länge des Datenabrufes dem der Formeln entspricht. Wenn nicht, dann sollen die Formeln so lange nach unten kopiert werden, bis die letzte Datenzeile erreicht ist.
Das wird auch gemacht.
Der Fehler: Der Bezug der Formeln der ersten Zeile, die eingefügt wird, geht nicht auf die nächste Zeile, wie es korrekt wäre, sondern auf die letzte Zeile des Datenabrufes. Die Bezüge der folgenden Zeilen gehen dann immer eins darunter, sodass sie sich auf die Zeilen unter dem Datenabruf beziehen - d.h. auf leere Zellen.
Das heißt die Formel wird zwar kopiert und eingefügt, was auch sein soll, aber der Bezug der Formeln ist falsch. Kann mir jemand sagen woran das liegt?
Ich hatte das makro zuerst so hinterlegt, dass es bei Aktualisierung der DB startet. Das hat nicht funktioniert. Dann bei Änderung des Blattes, das hat aber zu lange gedauert. Nun starte ich es manuell nachdem der Datenabruf abgeschlossen ist, aber dann passiert das bereits beschriebene. Kennt jemand solch einen Fall?
Das Makro lautet:
Sub Formeln()
Dim i As Integer
Dim j As Integer
Dim Sp As Integer
Application.ScreenUpdating = False
i = 1 'Zeile, von wo aus gestartet wird = Counter, wie viele Zeilen
j = 1 'Zeile, von wo aus gestartet wird = Counter, wie viele Zeilen
Sp = 1 'Spalte, von wo aus gestartet wird = Counter, wie viele Spalten
Do Until ActiveSheet.Range("A" & i).Value = "" 'Spalte A Zeilen zählen
i = i + 1
Loop
Do Until ActiveSheet.Range("K" & j).Value = "" 'Spalte K
j = j + 1
Loop
Do Until ActiveSheet.Cells(1, Sp).Value = "" 'In Zeile eins bei den Überschriften schauen
Sp = Sp + 1
Loop
If i > j Then 'so lange DB länger ist als Berechnung daneben
Do Until i - 1 = j - 1 'bis die Zeilen gleich sind
ActiveSheet.Range(Cells(j - 1, 11), Cells(j - 1, Sp - 1)).Select 'ab Spalte K (= 11) Zeilen markieren bis letzte Spalte = Counter Sp
Selection.Copy
j = j + 1
Range(Cells(j - 1, 11), Cells(j - 1, Sp - 1)).Select
Selection.PasteSpecial xlPasteFormulas
Loop
End If
Application.ScreenUpdating = True
End Sub
Sabi.