Plötzlicher Makrofehler führt zu falsch kalkulierten Ergebnissen HILFE!!!

[exblow375]

Hallo zusammen,

nicht erschrecken, der eigentliche Code ist nur ein Bruchteil von diesem langen Post. Es wiederholt sich mehr oder weniger und ich habe es nicht eleganter schreiben können (bin noch am Anfang).

Im Prinzip sieht jeder Schritt wie folgt aus:

Code:

Sub P()
Dim i As Double
Dim rng As Range
Set rng = Range("EE5:EY25")

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 2, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Ich habe eine Matrix in "EE5:EY25" die Ergebnisse im Bereich "EE27:EG27" ausspuckt, bestehend aus drei Werten die jeweils eine eigene Teilsumme aus der Matrix abbilden. Innerhalb der Matrix werden durch das Makro vor jeder neuen Kalkulation die Eingabewerte ausgetauscht (immer zwei Werte in zwei Spalten, die durchgearbeitet wird).
Nach jeder Kalkulation wird das Ergebnis aus "EE27:EG27" abgegriffen und einen anderen Bereich mit drei Spalten kopiert, in diesem Falle Spalte 66-69.Wenn das Ergebnis eingetragen ist und die Eingabewerte aus den beiden gesamten Spalten durchgerechnet sind, werden in der Matrix "EE5:EY25" die Eingabewerte ausgetauscht, sodass Eingabewerte aus zwei anderen Spalten genutzt werden wie im folgenden Codeschnipsel zu sehen.

Nun zu meinem Problem:
Ich bekomme ab der Stelle

Code:

rng.Replace "$U$25094", "$X$2134"
rng.Replace "$DBC$25094", "$DA$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 41, 66).PasteSpecial xlValues
Next i

, d.h. da wo Eingabewerte aus den Spalten X und DA verwendet werden (im gesamten Code ist die Stelle kurz hinter Hälfte), den dritten Ausgabewert als 0 angezeigt. 
Dieser Fehler setzt sich dann bis zum Ende des Makros fort! Nochmal zum Verständnis: in den Spalten 66-69 werden in der jeweiligen Zeile jeweils die Ergebnisse eingetragen doch irgendwann wird in Spalte 69 nur noch 0 ausgespuckt. Bei insgesamt 25000 Tabellenzeilen fängt dieser Fehler also ca. bei Zeile 13000 an, betrifft also einige Zeilen!!

Ich kann mir den Fehler nicht erklären, der Code ab dieser Stelle folgt dem selben Schema wie zuvor. Vorher werden auch alle Ergebnisse wie ich es will berechnet. Kann es sein das man das Makro aufteilen sollte weil der Rechenaufwand enorm ist?

Ich habe zum Verständnis nochmal den gesamten Code eingefügt: 

Code:

Sub P()
Dim i As Double
Dim rng As Range
Set rng = Range("EE5:EY25")

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 2, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$H$25094", "$DR$2134"
rng.Replace "$G$25094", "$DQ$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 5, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$DR$25094", "$H$2134"
rng.Replace "$DQ$25094", "$DQ$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 8, 66).PasteSpecial xlValues
Next i
Set rng = Nothing
Set rng = Range("EE5:EY25")
rng.Replace "$H$25094", "$H$2134"
rng.Replace "$DQ$25094", "$DR$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 11, 66).PasteSpecial xlValues
Next i
Set rng = Nothing


Set rng = Range("EE5:EY25")
rng.Replace "$H$25094", "$G$2134"
rng.Replace "$DR$25094", "$DR$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 14, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$G$25094", "$G$2134"
rng.Replace "$DR$25094", "$DQ$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 17, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$G$25094", "$D$2134"
rng.Replace "$DQ$25094", "$DS$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 20, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$D$25094", "$D$2134"
rng.Replace "$DS$25094", "$DT$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 23, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$D$25094", "$C$2134"
rng.Replace "$DT$25094", "$DS$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 26, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$C$25094", "$K$2134"
rng.Replace "$DS$25094", "$DL$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 29, 66).PasteSpecial xlValues
Next i
Set rng = Nothing


Set rng = Range("EE5:EY25")
rng.Replace "$K$25094", "$Q$2134"
rng.Replace "$DL$25094", "$DI$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 32, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$Q$25094", "$T$2134"
rng.Replace "$DI$25094", "$DC$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 35, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$T$25094", "$U$2134"
rng.Replace "$DC$25094", "$DB$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 38, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$U$25094", "$X$2134"
rng.Replace "$DBC$25094", "$DA$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 41, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$X$25094", "$Y$2134"
rng.Replace "$DA$25094", "$CZ$2134"



For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 44, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$Y$25094", "$Z$2134"
rng.Replace "$CZ$25094", "$CW$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 47, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$Z$25094", "$AB$2134"
rng.Replace "$CW$25094", "$CV$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 50, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$AB$25094", "$AC$2134"
rng.Replace "$CV$25094", "$CT$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 53, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$AC$25094", "$AE$2134"
rng.Replace "$CT$25094", "$CS$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 56, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$AE$25094", "$BA$2134"
rng.Replace "$CS$25094", "$BZ$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 59, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$BA$25094", "$AS$2134"
rng.Replace "$BZ$25094", "$CD$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 62, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$AS$25094", "$AY$2134"
rng.Replace "$CD$25094", "$CB$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 65, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$AY$25094", "$AQ$2134"
rng.Replace "$CB$25094", "$CF$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 68, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$AQ$25094", "$AL$2134"
rng.Replace "$CF$25094", "$BZ$2134"

For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 71, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$AL$25094", "$AJ$2134"
rng.Replace "$BZ$25094", "$CB$2134"


For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
    rng.Replace "$" & i - 82, "$" & i
    Application.Calculate
    Range("EE27:EG27").Copy
        Cells(i + 77, 66).PasteSpecial xlValues
Next i
Set rng = Nothing

Set rng = Range("EE5:EY25")
rng.Replace "$AJ$25094", "$H$2134"
rng.Replace "$CB$25094", "$G$2134"

End Sub

Ich bin euch sehr für eure Hilfe dankbar!!

[Gast 123]

Hallo

ich habe mir den Code einmal angesehen und denke man kann ihn sinnvoll kürzen.  Der wiederholt sich ja staendig!
Ob damit der Fehler behoben ist weiss ich nicht?? Vielleicht muss man nach dem berechnen ein kurze Verzögerung einbauen?
Die Set Anweisung für "rng" reicht m.E. einmal aus, der Wert aendert sich ja nicht! Sonst rng vor der 2. For Next durch Entfernen von  '  aktivieren. 

mfg  Gast 123

Code:

Sub P()
Dim i As Integer, j As Integer
Dim rng As Range
Set rng = Range("EE5:EY25")

For j = 2 To 77 Step 3
  'Set rng = Range("EE5:EY25")
  For i = 2216 To Cells(Rows.Count, 7).End(xlUp).Row Step 82
      rng.Replace "$" & i - 82, "$" & i
      Application.Calculate
      Range("EE27:EG27").Copy
      Cells(i + j, 66).PasteSpecial xlValues
 Next i
  rng.Replace "$H$25094", "$DR$2134"
  rng.Replace "$G$25094", "$DQ$2134"

Next j
End Sub

[exblow375]

Vielen Dank erstmal für deine Lösung! Ich vermute mal das ich dann noch alle anderen Spalten einfügen soll? In dem Beispiel sind es ja nur zwei Spaltenpaare die ersetzt werden?

[Klaus-Dieter]

Hallo,

es wäre sicher sinnvoll, wenn du hier eine Beispieldatei hochlädst. Was deine Quelltexte betrifft, die Dollarzeichen sind da überflüssig, die braucht man nur unter bestimmten Voraussetzungen bei Zellformeln.

[exblow375]

Leider hat der Code in jeder Zeile der Spalte 67 den Wert 100 ausgespuckt aber ich habe das Problem jetzt behoben..ich hatte einen dummen Schreibfehler!

Trotzdem danke für die Unterstützung!