Moin , habe gerade etwas gebastelt, um ein altes Excel-Diagramm-Problem in den Griff zu bekommen, nämlich die Gleichstellung der NullPunkte von linker und rechter y-Achse.
War nicht ganz einfach, aber es hat geklappt 
siehe hier:
Ein SchönheitsFehler dabei: Die Beschriftung der beiden Y-Achsen weist meistens krumme Werte auf.
Vielleicht fällt dazu Jemandem ein GegenMittel ein …
Freundliche Grüße
Thomas
Hi Thomas,
in deinem hochgeladenen Beispiel ist aber der Nullpunkt nicht gleich und die Zahlen „gerade“, also genau umgekehrt wie im Text beschrieben.
im konkreten Beispiel würd ich für primär und Sekundärachse die gleichen Zahlenwerte nehmen.
damit der Nullpunkt übereinstimmt, muß die Sekundärachse immer sowohl im negativen wie im positiven Abschnitt das gleiche Vielfache der Min/Max Werte der Primärachse sein, sonst funktioniert das nicht.
gruss
M@x
Hallo Max,
vielen Dank für Deine RückMeldung.
…
in deinem hochgeladenen Beispiel ist aber der Nullpunkt nicht
gleich und die Zahlen „gerade“, also genau umgekehrt wie im
Text beschrieben.
Genau. Das ist die AusgangsSituation. Wenn Du aber die linke der beiden SchaltFlächen betätigst, werden die NullPunkte auf gleiche Höhe gebracht. Alternativ kannst Du auch mit der Maus auf das Diagramm klicken.
im konkreten Beispiel würd ich für primär und Sekundärachse
die gleichen Zahlenwerte nehmen.
Hmhh. Die ZahlenWerte sollen sich schon unterscheiden, sonst bräuchte ich keine 2. Y-Achse. Im Beispiel unterscheiden sie sich um ca. 3 ZehnerPotenzen… Oder was meinst Du?
damit der Nullpunkt übereinstimmt, muß die Sekundärachse immer
sowohl im negativen wie im positiven Abschnitt das gleiche
Vielfache der Min/Max Werte der Primärachse sein, sonst
funktioniert das nicht.
Die Bedingung exakt zu formulieren, die für die gewünschte Darstellung einzuhalten ist, fällt mir nicht leicht. Deshalb habe ich es direkt in Formeln gepackt. Sicher ist es noch nicht perfekt, aber ich habe auch bisher keine endgültige Lösung der vielfach gestellten Frage gefunden und auch keinen brauchbaren Ansatz. Kann natürlich sein, dass ich da ´was übersehen habe. Dann wäre ich für entsprechende Hinweise dankbar.
Freundliche Grüße
Thomas
Grüezi Thomas
Moin , habe gerade etwas gebastelt,
Ja, im wahrsten Sinne des Wortes - ich musst meine Einrichtung von Excel komplett durchsuchen um die ungefragten Veränderungen an Grund-Einstellungen wieder zurück zu setzen.
Solches ohne Hinweis darauf einfach mal so hochzuladen ist schon fast fahrlässig…!!!
Wenn das für deine Anwendung notwendig ist ist das ja eine Sache, aber dann stelle das Ganze wenigstes beim Schliessen wieder sauber zurück.
Ein SchönheitsFehler dabei: Die Beschriftung der beiden
Y-Achsen weist meistens krumme Werte auf.
Vielleicht fällt dazu Jemandem ein GegenMittel ein …
Wie schon angemerkt worden ist müssten sich die beiden Achsen in gleich viele Abschitte unterteilen lassen.
Ev. kannst Du auch noch was steuern indem Du die Min/Max Werte der sekundären Achse auf die nächsten ganzzahligen Werte rundest.
Mit freundlichen Grüssen
Thomas Ramel
Grüezi Thomas
…aber sei es drum - hier mal ein Ansatz der einfach die kleiner der beiden Skalierungen auf die Werte der grösseren setzt. Unterschiedliche Dekaden werden dabei berücksichtigt:
Sub tr\_autoDiag()
Dim Max\_tot As Long
Dim Min\_tot As Long
Dim expo1 As Long
Dim expo2 As Long
ActiveSheet.ChartObjects("Diagramm 3").Activate
ActiveChart.Axes(xlValue).MinorUnitIsAuto = True
ActiveChart.Axes(xlValue).MajorUnitIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MinorUnitIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MajorUnitIsAuto = True
ActiveChart.Axes(xlValue).MinimumScaleIsAuto = True
ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MinimumScaleIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MaximumScaleIsAuto = True
expo1 = Int(Log(ActiveChart.Axes(xlValue).MaximumScale) / Log(10))
expo2 = Int(Log(ActiveChart.Axes(xlValue, xlSecondary).MaximumScale) / Log(10))
Max\_tot = WorksheetFunction.Max(ActiveChart.Axes(xlValue).MaximumScale / 10 ^ expo1, ActiveChart.Axes(xlValue, xlSecondary).MaximumScale / 10 ^ expo2)
Min\_tot = WorksheetFunction.Min(ActiveChart.Axes(xlValue).MinimumScale / 10 ^ expo1, ActiveChart.Axes(xlValue, xlSecondary).MinimumScale / 10 ^ expo2)
ActiveChart.Axes(xlValue).MaximumScale = Max\_tot \* 10 ^ expo1
ActiveChart.Axes(xlValue).MinimumScale = Min\_tot \* 10 ^ expo1
ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = Max\_tot \* 10 ^ expo2
ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = Min\_tot \* 10 ^ expo2
End Sub
Mit freundlichen Grüssen
Thomas Ramel
Das war keine Absicht - sorry
Hallo Thomas,
den ganzen Quatsch im Modul „diese Arbeitsmappe“ hätte ich löschen wollen - nur versehentlich vergessen. Das tut mir sehr leid wegen der Unannehmlichkeiten. Dein Kommentar dazu ist ja recht schonend …
Vielen Dank auch für Deine inhaltlichen Hilfen im nächsten Beitrag.
Werde ich umgehend testen und mich dann melden.
Bis dahin
freundliche Grüße
Thomas
Grüezi Thomas
den ganzen Quatsch im Modul „diese Arbeitsmappe“ hätte ich
löschen wollen - nur versehentlich vergessen. Das tut mir sehr
leid wegen der Unannehmlichkeiten. Dein Kommentar dazu ist ja
recht schonend …
Danke für deine nette Einschätzung - war ja auch kein grosser Beinbruch.
Ich wusste den Code zu lesen und so war auch rasch klar, welche Optionen ich wieder umstellen musste.
Da hatte ich letztens einen anderen ‚Kandidaten‘, der mir alle meine Symbolleisten komplett entfernt hatte, auch meine eigens angelegten mit meinen speziellen Befehlen und Einstellungen.
…dort war dann mein Kommentar auch etwas weniger schonend, und auf weitere Unterstützung meinerseits musste er dann auch verzichten… 
Vielen Dank auch für Deine inhaltlichen Hilfen im nächsten
Beitrag.
Werde ich umgehend testen und mich dann melden.
Ja, das ist fein - das Ganze ist noch nicht wirklich getestet und waterproof, aber könnte als Ansatz für weitere Betrachtungen dienen.
Mit freundlichen Grüssen
Thomas Ramel
Hi,
ja, bei mir hat das eine Sicherheitsmeldung gegeben, daher konnt ich die andere Variante gar nicht sehen, ich hätt mich im Unterschied zu Thomas sicher schwerer getan, das wieder in ordnung zu bringen.
Gruss
M@x
Hallo Thomas,
Dein Code läuft sehr gut. Eleganterweise ist auch die ganze Funktionalität im Code und es sind keine Formeln und HilfsZellen im RechenBlatt nötig >sauber
soll nicht wieder vorkommen
Hallo Max,
zum Glück ist bei Dir nichts verstellt worden. Hoffentlich auch bei keinem Mitlesenden. Da hätte ich gründlicher löschen sollen - nicht nur zur „Anonymisierung“.
Freundliche Grüße
Thomas
Grüezi Thomas
Dein Code läuft sehr gut. Eleganterweise ist auch die ganze
Funktionalität im Code und es sind keine Formeln und
HilfsZellen im RechenBlatt nötig >sauber
Bitte Link NICHT folgen!
Hallo,
beim „Anonymisieren“ der hochgeladenen ArbeitsMappe habe ich leider die Einstellungen in „diese Arbeitsmappe“ nicht gelöscht. Daher bitte nicht starten!
Zu empfehlen ist vielmehr der Code von Thomas Ramel in seinem 2. Post.
Freundliche Grüße
Thomas
P. S.: Natürlich habe ich die Mappe selber zum Testen heruntergeladen, aber bei mir hat sich nichts verändert, weil es meine StandardEinstellungen sind :-S
BeispielKurven folgen
Hallo Thomas,
werde morgen ( oder spätestens am WE ) die Beispiel-WerteMengen einstellen, aber nicht überstürzt …
Danke für Deine schnelle Reaktion und gute Nacht
Thomas
neuer Link
Hallo,
habe ein paar Beispiele zum Anpassen in die Mappe eingefügt und alle speziellen Einstellungen herausgenommen :-S
http://www.uploadagent.de/show-184623-1336726433.html
Freundliche Grüße
Thomas
Grüezi Thomas
habe ein paar Beispiele zum Anpassen in die Mappe eingefügt
und alle speziellen Einstellungen herausgenommen :-S
Das ist fein, Danke
Ich bin der Ursache auch schon auf der Spur - in den betreffenden Achsen gibt es ‚gebrochene‘ Maximalwerte, die bei der Umrechnung auf die nächst-kleinere Einheit heruntergebrochen werden.
Ich bin da bereits am tüfteln und habe auch schon die eine oder andere Idee für die Umsetzung.
Mit freundlichen Grüssen
Thomas Ramel
Grüezi Thomas nochmals
habe ein paar Beispiele zum Anpassen in die Mappe eingefügt
und alle speziellen Einstellungen herausgenommen :-SDas ist fein, Danke
Ich bin der Ursache auch schon auf der Spur - in den
betreffenden Achsen gibt es ‚gebrochene‘ Maximalwerte, die bei
der Umrechnung auf die nächst-kleinere Einheit
heruntergebrochen werden.Ich bin da bereits am tüfteln und habe auch schon die eine
oder andere Idee für die Umsetzung.
Hier ein erweiterter Ansatz, der auch eine Potenz weniger noch prüft:
Sub tr\_autoDiag()
Dim Max\_tot As Long
Dim Min\_tot As Long
Dim expo1 As Long
Dim expo2 As Long
ActiveSheet.ChartObjects("Diagramm 3").Activate
ActiveChart.Axes(xlValue).MinorUnitIsAuto = True
ActiveChart.Axes(xlValue).MajorUnitIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MinorUnitIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MajorUnitIsAuto = True
ActiveChart.Axes(xlValue).MinimumScaleIsAuto = True
ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MinimumScaleIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MaximumScaleIsAuto = True
expo1 = Log(ActiveChart.Axes(xlValue).MaximumScale) / Log(10)
expo2 = Log(ActiveChart.Axes(xlValue, xlSecondary).MaximumScale) / Log(10)
If (ActiveChart.Axes(xlValue).MaximumScale / 10 ^ expo1) 10 \* (ActiveChart.Axes(xlValue).MaximumScale / 10 ^ (expo1 - 1)) Then
expo1 = expo1 - 1
ElseIf (ActiveChart.Axes(xlValue, xlSecondary).MaximumScale / 10 ^ expo1) 10 \* (ActiveChart.Axes(xlValue, xlSecondary).MaximumScale / 10 ^ (expo1 - 1)) Then
expo1 = expo1 - 1
End If
If (ActiveChart.Axes(xlValue).MinimumScale / 10 ^ expo2) 10 \* (ActiveChart.Axes(xlValue).MinimumScale / 10 ^ (expo2 - 1)) Then
expo2 = expo2 - 1
ElseIf (ActiveChart.Axes(xlValue, xlSecondary).MinimumScale / 10 ^ expo2) 10 \* (ActiveChart.Axes(xlValue, xlSecondary).MinimumScale / 10 ^ (expo2 - 1)) Then
expo2 = expo2 - 1
End If
Max\_tot = WorksheetFunction.Max(ActiveChart.Axes(xlValue).MaximumScale / 10 ^ expo1, ActiveChart.Axes(xlValue, xlSecondary).MaximumScale / 10 ^ expo2)
Min\_tot = WorksheetFunction.Min(ActiveChart.Axes(xlValue).MinimumScale / 10 ^ expo1, ActiveChart.Axes(xlValue, xlSecondary).MinimumScale / 10 ^ expo2)
ActiveChart.Axes(xlValue).MaximumScale = Max\_tot \* 10 ^ expo1
ActiveChart.Axes(xlValue).MinimumScale = Min\_tot \* 10 ^ expo1
ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = Max\_tot \* 10 ^ expo2
ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = Min\_tot \* 10 ^ expo2
End Sub
Mit freundlichen Grüssen
Thomas Ramel
sehr gute Lösung
Hallo Thomas,
das Problem mit den abgeschnittenen Spitzen hast Du ja komplett gelöst, noch dazu sehr schnell. Ich habe heute den Kopf noch gar nicht frei genug bekommen, um überhaupt nachzuvollziehen, wie Du das genau gemacht hast …
Vielen herzlichen Dank und schönes WochenEnde
Thomas
Grüezi Thomas
das Problem mit den abgeschnittenen Spitzen hast Du ja
komplett gelöst, noch dazu sehr schnell.
Danke für die netten Blümchen, ich stelle sie in die virtuelle Vase
Ich habe heute den
Kopf noch gar nicht frei genug bekommen, um überhaupt
nachzuvollziehen, wie Du das genau gemacht hast …
Gut, dann investiere nicht allzviel Zeit darein, denn ich habe hier eine IMO noch schlankere Lösung gefunden:
Sub tr\_autoDiag2()
Dim Max\_tot As Double
Dim Min\_tot As Double
Dim expo1 As Long
Dim expo2 As Long
ActiveSheet.ChartObjects("Diagramm 3").Activate
ActiveChart.Axes(xlValue).MinorUnitIsAuto = True
ActiveChart.Axes(xlValue).MajorUnitIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MinorUnitIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MajorUnitIsAuto = True
ActiveChart.Axes(xlValue).MinimumScaleIsAuto = True
ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MinimumScaleIsAuto = True
ActiveChart.Axes(xlValue, xlSecondary).MaximumScaleIsAuto = True
expo1 = Log(ActiveChart.Axes(xlValue).MaximumScale) / Log(10)
expo2 = Log(ActiveChart.Axes(xlValue, xlSecondary).MaximumScale) / Log(10)
Max\_tot = Round(WorksheetFunction.Max(ActiveChart.Axes(xlValue).MaximumScale / 10 ^ expo1, \_
ActiveChart.Axes(xlValue, xlSecondary).MaximumScale / 10 ^ expo2), 2)
Min\_tot = Round(WorksheetFunction.Min(ActiveChart.Axes(xlValue).MinimumScale / 10 ^ expo1, \_
ActiveChart.Axes(xlValue, xlSecondary).MinimumScale / 10 ^ expo2), 2)
ActiveChart.Axes(xlValue).MaximumScale = Max\_tot \* 10 ^ expo1
ActiveChart.Axes(xlValue).MinimumScale = Min\_tot \* 10 ^ expo1
ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = Max\_tot \* 10 ^ expo2
ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = Min\_tot \* 10 ^ expo2
End Sub
Mit freundlichen Grüssen
Thomas Ramel
noch besser
Hallo Thomas,
beim Testen Deines neuesten Codes habe ich doch tatsächlich noch VerbesserungsPotential entdeckt: Die MomentenKurve nutzt bei manchen WerteMengen nur ca. die Hälfte des zur Verfügung stehenden Platzes. Ansonsten scheint es die perfekte Anpassung zu sein.
Vielen Dank für Deine ausgezeichnete Hilfe.
Freundliche Grüße
Thomas
Grüezi Thomas
beim Testen Deines neuesten Codes habe ich doch tatsächlich
noch VerbesserungsPotential entdeckt: Die MomentenKurve nutzt
bei manchen WerteMengen nur ca. die Hälfte des zur Verfügung
stehenden Platzes.
Ja, das ist durchaus möglich, da ja innerhalb der Dekaden die gleiche Skalierung verwendet wird wie in der Hauptachse. Damit gibt es keine Probleme mit der ‚Gleichstellung‘ der Null-Linie, andererseits aber wird möglicherweise etwas Platz ‚verschenkt‘.
Nutzt man mit der zweiten Achse den Platz aber optimal aus, dann wird es wieder schwierig, über die Skalierung der Achse die Lage der Null-Linie anzugleichen.
Grundsätzlich muss die grösser skalierte Achse immer ein Vielfaches der kleiner skalierten Achse sein, damit es mit der Teilung einerseits und mit der Lage der Null-Linie andererseits sauber klappt.
Vermutlich ist der Code durchaus noch ausbaufähig, das schliesse ich bei meinen Versuchen generell nie aus.
Besten Dank auch für dein Feedback
Mit freundlichen Grüssen
Thomas Ramel