|
Hallo Zusammen,
leider habe ich keinen ähnlichen Beitrag gefunden, der mir weiterhelfen konnnte.
Zuerst mein Code:
Dim letzte_zeile As Integer
Dim zeile_anf(0 To 1000) As Integer ' dieses Datenfeld merkt sich den Anfang eines Bereichs
Dim zeile_ende(0 To 1000) As Integer ' dieses Datenfeld merkt sich das Ende eines Bereichs
Dim schalter As Integer, ende As Integer ' Hilfsvariablen für for-Schleifen
Dim co1 As ChartObject, co2 As ChartObject, co3 As ChartObject ' werden zur Erstellung der Diagramme benötigt
Dim ch1 As Chart, ch2 As Chart, ch3 As Chart ' werden zur Erstellung der Diagramme benötigt
Dim i As Integer ' Laufvariable innerhalb des Datenfelds
Dim j As Integer ' Laufvariable für Zeilen
' *********************************************************************************************
' hier erfolgt die Berechnung der Bereiche nach denen die ersten zwei Diagramme erstellt werden
' *********************************************************************************************
Sub Zellen_Zaehlen()
' ************************************************************************************
' ACHTUNG: Die ha_korr steht aktuell in Spalte 44 (AR) ! Darauf wird hier aufgebaut!
' Sollte sich dies ändern müssen die folgenden Zeilen angepasst werden!
' ************************************************************************************
letzte_zeile = Cells(Rows.Count, 44).End(xlUp).Row
schalter = 0
i = 1
For j = 15 To letzte_zeile ' Startzeile ist 13 (vgl. bei Unstimmigkeiten Blatt "Berechnung Wht")
If (Cells(j, 44) > 0 And Cells(j, 44) <> "") And schalter = 0 Then
zeile_anf(i) = j ' Beginn eines Bereichs wird hier gesetzt, z.B. 1.Bereich: Beginn bei Zeile 13
If Cells(j, 44) <> "" Then
schalter = 1 ' schlater = 1 gesetzt, damit das Ende des Bereichs ermittelt werden kann
End If
End If
If Cells(j + 1, 44) = "" Then ' Hilfskonstruktion um die Funktion Abs in der nächsten Abfrage
Cells(j + 1, 44) = 0 ' bilden zu können; mit leeren Zellen nicht möglich
End If
' wenn die Abweichung der nächsten Zelle >= 0.5 ist (damit werden auch leere Zellen erfasst, da ihr
' Anfangswert oben auf 0 gesetzt wurde) wird hier das Ende des Bereichs ermittelt
If (Abs(Cells(j + 1, 44) - Cells(j, 44)) >= 0.5 And schalter = 1) Then
zeile_ende(i) = j ' Ende eines Bereichs wird hier gesetzt, z.B. 1.Bereich: Ende bei Zeile 70
schalter = 0 ' wird auf 0 gesetzt, damit der Beginn des nächsten Bereichs festgestellt wird
i = i + 1 ' nächster Bereich wird initialisiert, somit folgt: 2.Bereich: Beginn/Ende
End If
If Cells(j + 1, 44) = 0 And schalter = 0 Then ' die leeren Zellen werden wieder zurück gesetzt,
Cells(j + 1, 44) = "" ' somit wird das Ergebnis nicht verfälscht
End If
Next j
i = i - 1
End Sub
Kurze Erklärung:
zeile_anf soll sich ja den Anfang des jeweiligen Bereieches merken, also beim ersten Bereicht "15" und zeile_ende soll übersprungen werden bis eine Leerzeile kommt, die < 0,5 ist und deshalb das Ende eines Bereiches markiert. und dann wieder von vorne.
Das eigenartige ist, dass genau dieser Code in einer anderen Exceltabelle funktioniert. Ich habe diese kopiert und jetzt speichert sie die Bereiche nicht.
Sprich es wird jeder Punkt einzeln in einem Diagramm angezeigt. Obwohl es zum Beipsiel 3 Kurven sein sollten, erhalte ich stattdesssen 300 Einzelpunkte.
Vielen Dank schon mal im Voraus!!
Grüße Lari
|