Makro scheint sich "aufzuhängen"
26.02.2016 11:04:55
Martin
ich habe folgendes Problem mit einem meiner Excel-Makros:
Allgemein geht es hier darum, Erzeugungsdaten einer PV aus einem Basic-Data Sheet ihren Zeitpunkten zuzuordnen, immer nur auf den gewählten Zeitraum zugeschnitten.
In der Basic-Data befinden sich sämtliche verfügbare Inputdaten zur PV-Erzeugung auf niedrigster Aggregationsebene (also im 15-Minuten Intervall)
Durch das MAkro werden sie dann nur einem gewählten Zeitraum zugeordnet bzw. bei anderen Minutenintervallen aggregiert.
Gleich vorneweg: das mit den Preisen könnt ihr hier ignorieren.
Zunächst zum Makro:
Aufgerufen wird es über eine User-Form.
In dieser muss ein Start- und ein Enddatum eigegeben werden, zudem kann noch ein Zeitintervall (15 Minuten, 30 Minuten oder 60 Minuten) festgelegt werden.
Nun erstellt das Makro eine vertikale Liste für jeden Zeitpunkt in diesem festgelegten Zeitrahmen und im Abstand des gewählten Minutenintervalles.
Dann berechnet es die jeweiligen Erzeugungsmengen und ordnet sie den jeweiligen Zeitpunkten zu.
Dies läuft alles über Iterationen ab.
Nun ist das Problem, dass, egal wie lange ich warte, das Makro nicht vollständig durchläuft, sondern quasi "hängt". Breche ich das Makro nun ab und rufe das Codefenster auf sagt es mir, dass es einen Datumswert auf einmal nicht finden kann. Dieser ist jedoch in der Tat vorhanden und da dürfte es auch keine Probleme geben, da es die vorhergehenden WErte ebenfalls berechnen konnte.
Komisch ist ebenfalls, dass es zu unterschiedlichen Zeitpunkten "hängt", einmal nach ca 9000, einmal nach ca 12000 Iterationen.
Alle VAriablen sind zudem bereits auf long-Typ angepasst, um overflowprobleme mit int zu vermeiden.
Ist mit Sicherheit relativ kopmliziert das alles passend zu verstehen, auch garantiere ich nicht dafür dass das Makro perfekt ist, jedoch funktioniert es, zumindest wenn ich den Zeitraum nur kurz genug ist (bis max. 3 Monate also ca 3*24*30*3= ~7000 Iterationen).
Ich denke eher dass es an etwas liegt, das im Zusammenhang mit der relativ großen Anzahl an durchzuführenden Iterationen steht. Vielleicht hängt er sich daran auf?
Falls Fragen dazu bestehen einfach posten, ich versuche so genau wie möglich zu antworten.
Ich wäre euch dankbar wenn jemand eine Lösung hätte.
Danke
Martin
Option Explicit
Dim BasicData As Worksheet, Verwendungsprofil As Worksheet, Preisprofil As Worksheet
Dim arrStrombedarf() As Double, arrPVErtrag() As Double, arrPVEigen() As Double, _
arrSpeicherBilanz() As Double, _
arrPVEinspeisung() As Double, arrNetzbezug() As Double, arrDatum() As Double, arrUhrzeit() As _
Double, varDatumUhrzeit As Variant
Dim rngMonths As Range, rngTimes As Range ' Hier werden die Bereiche von Monate und _
Zeiten der PV-Data festgelegt, um später die Werte finden zu können
Dim lngUsedRange As Long 'Anzahl benutzter Zellen
Dim k As Variant 'For-Schleifen-Counter
Private Sub UserForm_initialize()
With Me.minuteInterval
.AddItem "15"
.AddItem "30"
.AddItem "60"
End With
End Sub
Private Sub enddatum_AfterUpdate()
If IsDate(enddatum) Then enddatum = Format(enddatum, "DD.MM.YYYY")
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = False
Dim ThisWS As Worksheet, rngTargetCell As Range, lngRowTargetCell As Long, intColumnTargetCell _
As Integer, insertDate As Date
Dim enddatumDate As Date 'Funktionale Variable, damit enddatumsvariable mit _
insertDatevariable vergleichbar
Dim insertTime As Date
Dim i As Integer, j As Integer, C As Long, dayPeriods As Integer 'Anzahl der Tagesperioden, _
abhängig von der Zeiteinteilung
dayPeriods = (24 * 60) / minuteInterval 'Tagesperioden aufgrund _
des Intervalls ermitteln
C = 1 'Periodencounter
Set Verwendungsprofil = ThisWorkbook.Sheets("Verwendungsprofil")
Set BasicData = ThisWorkbook.Sheets("BasicData")
Set Preisprofil = ThisWorkbook.Sheets("Preisprofil")
For j = 1 To 2 'Verwendungs- & Preisprofil durchgehen
C = 1 'Periodencounter wieder auf 1
If j = 1 Then
Set ThisWS = ThisWorkbook.Sheets("Verwendungsprofil")
Set rngTargetCell = ThisWS.Range("A1:J500").Find("Datum", LookIn:=xlValues) 'Benutzte _
Zeile finden "Datum" finden
lngRowTargetCell = rngTargetCell.Row
intColumnTargetCell = rngTargetCell.Column
ElseIf j = 2 Then
Set ThisWS = ThisWorkbook.Sheets("Preisprofil")
Set rngTargetCell = ThisWS.Range("A1:J500").Find("Datum", LookIn:=xlValues) 'Benutzte _
Zeile finden "Datum" finden
lngRowTargetCell = rngTargetCell.Row
intColumnTargetCell = rngTargetCell.Column
End If
With ThisWS
insertDate = startdatum
enddatumDate = CDate(enddatum)
enddatumDate = DateSerial(Year(enddatum), Month(enddatum), Day(enddatum) + 1) '(+1 da _
Enddatum auch noch abgehandelt werden soll
Do Until CDate(insertDate) = CDate(enddatumDate) 'Starte bei "Datum" und füge das _
Datum ein bis zum genannten Enddatum
insertTime = TimeSerial(Hour(0), Minute(0), Second(0)) 'Starte bei 00:00:00 Uhr _
und ende bei 23:45 Uhr
For i = 1 To dayPeriods 'FÜge das Datum so oft ein, wie es dazu Zeitpunkte _
(00:00 Uhr - 00:00 Uhr) gibt
.Cells(lngRowTargetCell + 1, intColumnTargetCell) = insertDate + insertTime
.Cells(lngRowTargetCell + 1, intColumnTargetCell).NumberFormat = "DD.MM.YYYY hh: _
mm:ss"
.Cells(lngRowTargetCell + 1, intColumnTargetCell + 1) = insertTime
.Cells(lngRowTargetCell + 1, intColumnTargetCell - 1) = C 'Füge Periodenzahl an
insertTime = TimeSerial(Hour(insertTime), Minute(insertTime) + minuteInterval, _
Second(insertTime)) 'Zähle um Intervall weiter
lngRowTargetCell = lngRowTargetCell + 1
C = C + 1
Next i
insertDate = DateSerial(Year(insertDate), Month(insertDate), Day(insertDate) + 1)
Loop
End With
Next j
Call GetInput
Application.ScreenUpdating = True
Application.Calculation = True
Unload UserForm1
End Sub
Sub GetInput() 'Diese Sub befüllt PV-Ertrag und die Preise mit dessen zugehörigen Zahlen, _
anhängig von den Inputparametern
Dim intTargetRow As Integer, rngTargetRow As Range, intTargetColumn As Integer, rngTargetCell _
As Range 'Zielvariablen
Dim intSourceRow As Integer, rngSourceRow As Range, intSourceColumn As Integer, rngSourceColumn _
As Range, rngSourceCell As Range 'Quellvariablen
Set Verwendungsprofil = ThisWorkbook.Sheets("Verwendungsprofil")
Set BasicData = ThisWorkbook.Sheets("BasicData")
Set Preisprofil = ThisWorkbook.Sheets("Preisprofil")
Call Define_Fill_Arrays
'***Berechnung Speicherleistung/Zeitintervall************
With Verwendungsprofil
.Range("speicher_leistung") = .Range("C3") / (60 / minuteInterval)
End With
'***PV-Stromerzeugung***
Set rngTargetCell = Verwendungsprofil.Range("A1:Z100000").Find("PV-Ertrag", LookIn:=xlValues)
For k = 1 To lngUsedRange
If minuteInterval = 15 Then
Set rngSourceCell = rngTimes.Find(Verwendungsprofil.Range("A1:Z100000").Cells( _
rngTargetCell.Row + k, rngTargetCell.Column - 2), LookIn:=xlFormulas)
Verwendungsprofil.Range("A1:Z100000").Cells(rngTargetCell.Row + k, rngTargetCell.Column) _
= BasicData.Range("A1:Z100000").Cells(rngSourceCell.Row, rngSourceCell.Column + 4)
ElseIf minuteInterval = 30 Then
Set rngSourceCell = rngTimes.Find(Verwendungsprofil.Range("A1:Z10000").Cells( _
rngTargetCell.Row + k, rngTargetCell.Column - 2), LookIn:=xlFormulas)
Verwendungsprofil.Range("A1:Z10000").Cells(rngTargetCell.Row + k, rngTargetCell.Column) _
= _
BasicData.Range("A1:Z100000").Cells(rngSourceCell.Row, rngSourceCell.Column + 4) + _
BasicData.Range("A1:Z100000").Cells(rngSourceCell.Row + 1, rngSourceCell.Column + 4)
ElseIf minuteInterval = 60 Then
Set rngSourceCell = rngTimes.Find(Verwendungsprofil.Range("A1:Z10000").Cells( _
rngTargetCell.Row + k, rngTargetCell.Column - 2), LookIn:=xlFormulas)
Verwendungsprofil.Range("A1:Z10000").Cells(rngTargetCell.Row + k, rngTargetCell.Column) _
= _
BasicData.Range("A1:Z100000").Cells(rngSourceCell.Row, rngSourceCell.Column + 4) + _
BasicData.Range("A1:Z100000").Cells(rngSourceCell.Row + 1, rngSourceCell.Column + 4) + _
_
BasicData.Range("A1:Z100000").Cells(rngSourceCell.Row + 2, rngSourceCell.Column + 4) + _
_
BasicData.Range("A1:Z100000").Cells(rngSourceCell.Row + 3, rngSourceCell.Column + 4)
End If
Next k
'Fehlereliminierung für "00:00:00" Uhr
If Verwendungsprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column - 1) = 0 Then ' _
Format("00:00", "h:mm;@")
Verwendungsprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column) = 0
End If
'Call Get_Prices
End Sub
Sub Get_Prices()
Dim rngTargetCell As Range, rngTargetCell2 As Range, varDatumUhrzeit As Variant
Set Verwendungsprofil = ThisWorkbook.Sheets("Verwendungsprofil")
Set BasicData = ThisWorkbook.Sheets("BasicData")
Set Preisprofil = ThisWorkbook.Sheets("Preisprofil")
'***Preis Verkauf*******
Set rngTargetCell = Preisprofil.Range("A1:Z10000").Find("Preis Verkauf", LookIn:=xlValues)
For k = 1 To lngUsedRange
varDatumUhrzeit = Preisprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column - 1) + _
Preisprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column - 2)
Set rngTargetCell2 = BasicData.Range("F1:ZZ100000").Find(CDate(varDatumUhrzeit), LookIn: _
=xlFormulas)
Preisprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column) = BasicData.Cells( _
rngTargetCell2.Row, rngTargetCell2.Column + 1)
Next k
'***Preis Kauf**********
Set rngTargetCell = Preisprofil.Range("A1:Z10000").Find("Preis Kauf", LookIn:=xlValues)
For k = 1 To lngUsedRange
varDatumUhrzeit = Preisprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column - 2) + _
Preisprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column - 3)
Set rngTargetCell2 = BasicData.Range("F1:ZZ100000").Find(CDate(varDatumUhrzeit), LookIn: _
=xlFormulas)
Preisprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column) = BasicData.Cells( _
rngTargetCell2.Row, rngTargetCell2.Column + 2)
Next k
'***Preis Speicherung***
Set rngTargetCell = Preisprofil.Range("A1:Z10000").Find("Preis Speicherung", LookIn:=xlValues)
For k = 1 To lngUsedRange
varDatumUhrzeit = Preisprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column - 3) + _
Preisprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column - 4)
Set rngTargetCell2 = BasicData.Range("F1:ZZ100000").Find(CDate(varDatumUhrzeit), LookIn: _
=xlFormulas)
Preisprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column) = BasicData.Cells( _
rngTargetCell2.Row, rngTargetCell2.Column + 3)
Next k
End Sub
Sub Define_Fill_Arrays() '******* Diese Sub befüllt alle Arrays
Call BenutzteZellenanzahl
Dim k As Variant
Dim Zeitcode As Double, measure As String '*mit measure noch verallgemeinern
Dim rngTargetRow As Range, rngTargetColumn As Range, rngTargetCell As Range, rngDatumUhrzeit As _
Range
'******Monatscode und Zeitcode in Range festlegen*******
'Set rngTargetCell = BasicData.Range("A1:Z10000").Find("Jan", LookIn:=xlValues)
'Set rngMonths = BasicData.Range(Cells(rngTargetCell.Row + 1, rngTargetCell.Column), Cells( _
rngTargetCell.Row + 1, rngTargetCell.Column + 11))
Set rngMonths = BasicData.Range("M5:X5")
'Set rngTargetCell = BasicData.Range("F1:Z10000").Find("0:00", LookIn:=xlValues)
'Set rngTimes = BasicData.Range(Cells(rngTargetCell.Row, rngTargetCell.Column), Cells( _
rngTargetCell.Row + 96, rngTargetCell.Column))
Set rngTimes = BasicData.Range("F4:F35043")
'***Datum**********
ReDim arrDatum(1 To lngUsedRange)
Set rngTargetCell = Verwendungsprofil.Range("A1:Z10000").Find("Datum", LookIn:=xlValues)
For k = 1 To UBound(arrDatum)
arrDatum(k) = Verwendungsprofil.Cells(rngTargetCell.Row + k, rngTargetCell.Column).Value
Next k
End Sub
Sub BenutzteZellenanzahl()
Dim ThisWS As Worksheet, rngTargetCell As Range, intAnzahlZeilen As Integer
Dim i As Integer 'Anzahl benutzter Zellen
Set ThisWS = ThisWorkbook.Sheets("Verwendungsprofil")
Set rngTargetCell = ThisWS.Range("A1:J500").Find("Datum", LookIn:=xlValues) '*Benutzte Zeile _
finden "Datum" finden
With ThisWS
Do Until .Cells(rngTargetCell.Row + 1 + lngUsedRange, rngTargetCell.Column) = "" 'Starte _
bei "Strom-Bedarf" und Zähle die Zellen entlang der genutzen Spalte
lngUsedRange = lngUsedRange + 1
Loop
End With
End Sub