Beim Diagramm die Achsen kalibrieren

Question

Einen schönen Nachmittag allerseits!

Ich möchte in meinem Diagramm die Achsen kalibrieren:

Die Eckpunkte können hier eingegeben werden, die Ergebnisse auf der rechten Seite werden mithilfe von Excel-Formeln berechnet. So weit, so gut.

Wie ersichtlich, sind die Einheitsstrecken 01 auf der y-Achse größer als auf der x-Achse.
Nun möchte ich aber diese so kalibrieren, dass die Einheitsstrecken auf beiden Achsen gleich groß sind.
Warum möchte ich das erreichen: die Winkel werden automatisch berechnet. Durch die unterschiedlichen Einheitsstrecken werden die Winkel jedoch verzerrt dargestellt.

Ich habe alles Mögliche und Unmögliche probiert, bisher leider erfolglos.
Gibt es eine Möglichkeit, dies zu ändern.
Meine Einstellungen sehen wie folgt aus:

Ich nehme an, dass es an den Auto-Einstellungen liegt (ist natürlich von Vorteil, da das Koordinatensystem automatisch an die Eingabe angepasst wird).
Mir würde eine Einstellung von MAX +10 - 10 auf beiden Achsen genügen.

In der Hoffnung, dass es mit ein paar Klicks an der richtigen Stelle eine Lösung gibt, wünsche ich allen noch einen angenehmen Restnachmittag.

Robert

Answer 1

Hi Robert,

ein paar Klicks an der richtigen Stelle helfen da leider nicht, denn bei einer automatischen Achsenskalierung macht Excel eben genau das wie in deinem Screenshot: die Skalierung erfolgt so, dass die Maixima/Minima beider Achsen so liegen, dass mindestens 1 freier Hauptstrich zusätzlich vorhanden ist und wenn Y- und X-Maximum/Minimum sehr unterschiedlich sind, werden beide Achsen eben auch sehr unterschiedlich skaliert.

Wenn du jedoch für beide Achsen dieselben Max-/Minwerte einstellen willst, dann geht das nur mithilfe von VBA. Mache einen Rechtsdklick auf den Tabellenreiter -> Code anzeigen und kopiere folgenden Code in das rechte (obere) Codefenster:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim dblScale As Double
    If Not Intersect(Target, Range("C5:D8")) Is Nothing Then
        If Application.Min(Range("C5:D8")) >= Application.Max(Range("C5:D8")) Then
            dblScale = Application.Min(Range("C5:D8")) - 10
        Else
            dblScale = Application.Max(Range("C5:D8")) + 10
        End If
        With ActiveSheet.ChartObjects(1).Chart
            With .Axes(xlCategory)
                .MinimumScale = -dblScale
                .MaximumScale = dblScale
            End With
            With .Axes(xlValue)
                .MinimumScale = -dblScale
                .MaximumScale = dblScale
            End With
        End With
    End If
End Sub

Sobald ein Wert im Bereich der Zellen C5:D8 verändert wird, passt sich die Achsenskalierung an.

Vergiss nicht, die Mappe anschließend im Format XLSM (Arbeitsmappe mit Makros) abzuspeichern.

Bis später, Karin

Answer 2

Hallo Karin!

Recht herzlichen Dank für deine Hilfe und den vba-Code.

Ich nehme an, ich muss noch eine Einstellung verändern, da das Ergebnis bei mir so aussieht:

Ich habe bei der Achenformatierung die Auto-Funktion, bzw. die Maximumausgabe gewählt, aber in beiden Fällen sieht das Ergebnis wie oben aus.

Helfen jetzt vielleicht ein paar kurze Klicks? 

Danke Robert

Answer 3

Hi Robert,

du musst nur die Hauptstriche für beide Achsen auf 1 stellen, den Rest macht der Code. Im Anhang meine Mappe.

https://supportnet.de/forum/?qa=blob&qa_blobid=13170675698217821282

Bis später, Karin

Answer 4

Hallo Karin!

Dank deiner Hilfe klappt es jetzt. Nur eine Frage habe ich noch: im Code wird das Minimum und das Maximum z. B. mit 10 bzw. -10 festgelegt. Im Diagramm werden die MIN und MAX aber mit 16 angezeigt.
Nichts Weltbewegendes, aber wenn jetzt der Code schon nicht mehr macht, was ich will, dann sehe ich schwarz für meine Zukunft.

LG Robert

Answer 5

Hi Robert,

ich hatte da noch einen Denkfehler, denn es muss immer der Absolutwert genommen werden - so sollte es jetzt richtig funktionieren:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim dblScale As Double
    If Not Intersect(Target, Range("C5:D8")) Is Nothing Then
        If Abs(Application.Min(Range("C5:D8"))) >= Abs(Application.Max(Range("C5:D8"))) Then
            dblScale = Abs(Application.Min(Range("C5:D8")))
        Else
            dblScale = Abs(Application.Max(Range("C5:D8")))
        End If
        dblScale = dblScale + 10
        With ActiveSheet.ChartObjects(1).Chart
            With .Axes(xlCategory)
                .MinimumScale = -dblScale
                .MaximumScale = dblScale
            End With
            With .Axes(xlValue)
                .MinimumScale = -dblScale
                .MaximumScale = dblScale
            End With
        End With
    End If
End Sub

Bis später, Karin

Answer 6

Hallo Karin!

Jetzt bin ich erleichtert und sehe meiner Zukunft „absolut rosiger“ entgegen.

Danke, Robert

Answer 7

Hallo Karin!

Es funkt immer noch nicht. Ich verwende Office 365, daran kann es wohl nicht liegen. Ich gehe davon aus, dass die Achsenformatierungen nicht passen (diese stellen sich nach jeder Änderung automatisch wieder um).

Ich schicke dir mal meine Datei, mit der Bitte, die Formatierungen zu überprüfen.

https://www.dropbox.com/scl/fi/9nxzjsorg6as6k10nwsas/Allgemeines-Viereck.xlsm?dl=0&rlkey=044ui0y6b0zjwwh5xj2nefk3n

Ich hoffe, du bringst weiterhin die Geduld auf, mich bei einem an und für sich nicht unbedingt existenziellen Problem zu helfen.

Danke dafür.

Robert