Hallo zusammen,
ich habe ein VBA-Problem und hoffe, jemand von Euch kann mir helfen.
Ich habe eine Tabelle, welche von einer Variable abhängt, aufgebaut. Diese Variable variiere ich jetzt mit Hilfe einer For-Schleife 96 mal (entspricht Viertelstunden eines Tages), zusätzlich werden zwei Diagramme erzeugt, die den Tabelleninhalt abhängig von der "Uhrzeit" darstellt, dadurch entsteht quasi ein "sich bewegendes" Diagramm. Ich möchte nun, dass sich die MIN- und MAX-Werte der y-Achse des Diagramms nicht bei jedem neuen Zeitschritt ändern, sondern dass diese durch das MIN und MAX einer Spalte während der gesamten Schleife bestimmt werden. Die Werte können jeweils positiv und negativ werden (es geht um Temperaturen und Wärmeströme durch eine Wand; x-Achse währe die Wanddicke in cm und y-Achse Temperatur in °C bzw. Wärmestrom in W/m²).
Hier mal mein Code:
Private Sub CommandButton1_Click()
Dim t As Integer
Dim dt, min_theta, max_theta, min_q, max_q, min_theta_neu, max_theta_neu, min_q_neu, max_q_neu As Single
Dim min_theta_runden, max_theta_runden, min_q_runden, max_q_runden As Integer
t = 0 'Startzeit
dt = Cells(8, 26) 'Intervall
Cells(2, 34) = t
'Ermittlung MIN/MAX
For t = 0 To 24 / dt
Cells(2, 34) = t * dt
min_theta = Application.Min(Range("AK:AK"))
max_theta = Application.Max(Range("AK:AK"))
min_q = Application.Min(Range("AL:AL"))
max_q = Application.Max(Range("AL:AL"))
'Ermittlung MIN Theta
If min_theta < min_theta_neu Then
min_theta_neu = min_theta
End If
'Ermittlung MAX Theta
If max_theta > max_theta_neu Then
max_theta_neu = max_theta
End If
'Ermittlung MIN q
If min_q < min_q_neu Then
min_q_neu = min_q
End If
'Ermittlung MAX q
If max_q > max_q_neu Then
max_q_neu = max_q
End If
Next
'Runden (Excel rundet bei negativen Zahlen in die falsche Richtung, z.B. -3,12 ergibt aufgerundet -3,2)
'Theta auf 5er-Stellen
'q auf 10er-Stellen
If min_theta_neu > 0 Then
min_theta_runden = Application.WorksheetFunction.RoundDown(min_theta_neu / 5, 0) * 5
Else
min_theta_runden = Application.WorksheetFunction.RoundUp(min_theta_neu / 5, 0) * 5
End If
If max_theta_neu > 0 Then
max_theta_runden = Application.WorksheetFunction.RoundUp(max_theta_neu / 5, 0) * 5
Else
max_theta_runden = Application.WorksheetFunction.RoundDown(max_theta_neu / 5, 0) * 5
End If
If min_q_neu > 0 Then
min_q_runden = Application.WorksheetFunction.RoundDown(min_q_neu, -1)
Else
min_q_runden = Application.WorksheetFunction.RoundUp(min_q_neu, -1)
End If
If max_q_neu > 0 Then
max_q_runden = Application.WorksheetFunction.RoundUp(max_q_neu, -1)
Else
max_q_runden = Application.WorksheetFunction.RoundDown(max_q_neu, -1)
End If
'Übertragung der MIN/MAX-Werte zur Überprüfung
Cells(1, 1) = min_theta_neu
Cells(2, 1) = max_theta_runden
Cells(3, 1) = min_q_runden
Cells(4, 1) = max_q_runden
'Achsen auf MIN/MAX-Werte setzen
ActiveSheet.ChartObjects("Diagramm 1").Activate 'Diagramm Theta
ActiveChart.Axes(xlValue).MinimumScale = min_theta_runden
ActiveChart.Axes(xlValue).MaximumScale = max_theta_runden
ActiveChart.Axes(xlCategory).MaximumScale = Range("AD57")
ActiveSheet.ChartObjects("Diagramm 2").Activate 'Diagramm q
ActiveChart.Axes(xlValue).MinimumScale = min_q_runden
ActiveChart.Axes(xlValue).MaximumScale = max_q_runden
ActiveChart.Axes(xlCategory).MaximumScale = Range("AD57")
t = 0
'Erstellung Diagramme
For t = 0 To 24 / dt
Cells(2, 34) = t * dt
ActiveSheet.ChartObjects("Diagramm 1").Activate 'aktualisiert Diagramm 1
ActiveSheet.ChartObjects("Diagramm 2").Activate 'aktualisiert Diagramm 2
Application.Wait (Now + TimeSerial(0, 0, 1)) 'lässt Schleife 1 sek warten (Dezimalzahlen gehen nicht)
Next
Cells(2, 34) = 0
End Sub
Ich vermute, dass bei der If-Schleife zur MIN-/MAX-Bestimmung etwas nicht passt, aber finde leider keinen Fehler, zumal ich nur begrenzte Programmierkenntnisse habe.
Ich hoffe, jemand von Euch kann mir helfen, das Problem zu beseitigen :)
LG Sebastian
|