Array wird zur Laufzeit beschädigt
05.02.2016 15:01:06
masl
ich habe aktuell ein, für mich unlösbares Problem und hoffe, dass Ihr mir dabei helfen könnt.
Ich habe ein VBA-Makro geschrieben, welches seit Wochen ohne Probleme funktioniert hat. Seit dem heutigen Ausführen (keinerlei Änderungen am Makro), kommt es allerdings immer zu einem Laufzeitfehler (9).
Der Fehler tritt immer nach Erreichen von i = 8932 auf. Das Array "arDaten" ist vor diesem Schritt ordnungsgemäß mit Daten befüllt (max 9120). Dann aber auf einmal leer.
Auch führt es sehr oft zum Absturz von Excel.
Ich bin da nun wirklich mit meinem Latein am Ende. Ich habe mit diesem Makro schon immens größere Datenmengen ohne Probleme verarbeitet.
Ich würde mich sehr über Eure Hilfe freuen
Gruß
masl
Hier das Makro:
Sub Mittelwerte()
Dim arDaten(), arMittel() As Variant
ReDim arMittel(100000, 7)
Call Daten(arDaten)
Call Mittelwert(arDaten, arMittel)
End Sub
Sub Daten(arDaten)
Dim imax
'Maximum bestimmen
Worksheets("Daten").Activate
Range("B2").Select
Selection.End(xlDown).Select
imax = Selection.Row - 1
'Daten in Array einlesen
arDaten = Range("B2:H" & imax)
End Sub
Sub Mittelwert(arDaten, arMittel)
Dim i, GESi, KKVi, d, m, h, min, minNext, ix, dNext, GES, GESd, KKVd, KKV, ih, id
ih = 1
id = 1
For i = LBound(arDaten) + 1 To UBound(arDaten)
If i = UBound(arDaten) Then
GoTo fertig
End If
d = arDaten(i, 1)
m = arDaten(i, 2)
h = arDaten(i, 4)
min = arDaten(i, 5)
KKVi = arDaten(i, 6)
GESi = arDaten(i, 7)
minNext = arDaten(i + 1, 5)
dNext = arDaten(i + 1, 1)
'
KKV = KKV + KKVi
GES = GES + GESi
di = di + 1
If minNext = 0 Then
KKVh = KKV / 4 'Verbrauchsmittelwert pro h
GESh = GES / 4 'Verbrauchsmittelwert pro h
KKVd = KKVd + KKVh ''Verbrauchsmittelwert pro d
GESd = GESd + GESh
If d dNext Then
If arDaten(1, 7) = "ta" Then
GESd = GESd / 24
End If
arMittel(id, 1) = d
arMittel(id, 2) = m
arMittel(id, 3) = KKVd
arMittel(id, 4) = GESd
KKVd = 0
GESd = 0
id = id + 1
End If
KKV = 0
GES = 0
End If
If i = 8931 Then
Debug.Print
End If
Next i
fertig:
Worksheets("Verbrauch").Activate
For p = LBound(arMittel) + 1 To UBound(arMittel)
Cells(p + 1, 2) = arMittel(p, 1)
Cells(p + 1, 3) = arMittel(p, 2)
Cells(p + 1, 4) = arMittel(p, 3)
Cells(p + 1, 5) = arMittel(p, 4)
Next p
End Sub