PC Hilfe bei Diagramm - Excel- oder Grafikprofis?
- Ersteller brabbijt
- Erstellt am
Benutzer, welche sich diesen Thread anschauen:
oh, danke.
Hier eine erste Version, die jeden zweiten Wert der Beschriftung entfernt. Bitte erst in einer Sicherungskopie deiner Datei testen. Eigentlich sollte es gehen, aber man weis ja nie. Mache also erst eine Kopie deiner Originaldatei.
Du musst das zu bearbeitende Diagramm markieren und dann das Makro starten. Dann wirst du aufgefordert eine Reihennummer einzugeben, die bearbeitet werden soll. (Wenn nur eine Datenreihe im Diagramm ist, dass ist das 1) Dann kannst du optional eine Start- und Endspalte eintragen. Wenn du da eines frei lässt, dann wird das ganze Diagramm bearbeitet.
EDIT:
Num mit Min/Max Funktion für numerische Datenwerte
Du musst das zu bearbeitende Diagramm markieren und dann das Makro starten. Dann wirst du aufgefordert eine Reihennummer einzugeben, die bearbeitet werden soll. (Wenn nur eine Datenreihe im Diagramm ist, dass ist das 1) Dann kannst du optional eine Start- und Endspalte eintragen. Wenn du da eines frei lässt, dann wird das ganze Diagramm bearbeitet.
EDIT:
Num mit Min/Max Funktion für numerische Datenwerte
Code:
Option Base 1
Sub LabelEntfernen()
Dim Reihe As Variant, Bereichstart As Variant, Bereichende As Variant
Dim NumPoints As Long, i As Long
Dim Mode As Variant
Dim min As Long, max As Long
Reihe = InputBox("Bitte geben Sie einen Wert für Reihe ein:", "Dateneingabe:")
If Reihe = "" Then Exit Sub
Reihe = Val(Reihe)
Mode = InputBox("Bitte geben Sie einen Wert für Mode ein:(0 = Min/Max anzeigen, 1 = jeden zweiten Wert entfernen)", "Dateneingabe:")
If Mode = "" Then Exit Sub
Mode = Val(Mode)
Bereichstart = InputBox("Bitte geben Sie einen Wert für Bereichsstart ein:", "Dateneingabe:")
Bereichende = InputBox("Bitte geben Sie einen Wert für Bereichsende ein:", "Dateneingabe:")
Bereichstart = Val(Bereichstart)
Bereichende = Val(Bereichende)
If Reihe = 0 Then Reihe = 1
NumPoints = ActiveChart.SeriesCollection(Reihe).Points.Count
Dim MinMaxValues As Variant
MinMaxValues = ActiveChart.SeriesCollection(Reihe).Values
min = MinMaxValues(1)
max = MinMaxValues(1)
If Bereichstart = 0 Or Bereichende = 0 Then
For i = 1 To NumPoints
If MinMaxValues(i) < min Then min = MinMaxValues(i)
If MinMaxValues(i) > max Then max = MinMaxValues(i)
Next i
If Mode = 0 Then 'Min Max
For i = 1 To NumPoints
If MinMaxValues(i) <> min And MinMaxValues(i) <> max Then ActiveChart.SeriesCollection(Reihe).Points(i).DataLabel.Text = ""
Next i
ElseIf Mode = 1 Then
For i = 1 To NumPoints
If i Mod 2 = 0 Then
If ActiveChart.SeriesCollection(Reihe).Points(i).HasDataLabel = True Then
ActiveChart.SeriesCollection(Reihe).Points(i).DataLabel.Text = ""
End If
End If
Next i
End If
Else
If Bereichende > NumPoints Then Bereichende = NumPoints
If Mode = 0 Then 'Min/Max
For i = Bereichstart To Bereichende
If MinMaxValues(i) < min Then min = MinMaxValues(i)
If MinMaxValues(i) > max Then max = MinMaxValues(i)
Next i
For i = Bereichstart To Bereichende
If MinMaxValues(i) <> min And MinMaxValues(i) <> max Then ActiveChart.SeriesCollection(Reihe).Points(i).DaraLabel.Text = ""
Next i
ElseIf Mode = 1 Then
For i = Bereichstart To Bereichende
If Bereichstart Mod 2 = 0 Then 'Start an gerader Stelle
If i Mod 2 = 1 Then
If ActiveChart.SeriesCollection(Reihe).Points(i).HasDataLabel = True Then
ActiveChart.SeriesCollection(Reihe).Points(i).DataLabel.Text = ""
End If
End If
Else 'Start an ungerader Stelle
If i Mod 2 = 0 Then
If ActiveChart.SeriesCollection(Reihe).Points(i).HasDataLabel = True Then
ActiveChart.SeriesCollection(Reihe).Points(i).DataLabel.Text = ""
End If
End If
End If
Next i
End If
End If
End Sub
