Beschriftung der Datenpunkte nach Filtern nicht korrekt
#1
Hallo zusammen,
ich erzeuge ein Punktdiagramm, wobei die Datenpunkte jeweils mit dem ersten Buchstaben des Vor- und Nachnamens beschriftet werden sollen. Leider erfolgt die Beschriftung nach Filtern nicht korrekt, sprich die Punkte werden korrekt abgebildet, jedoch verrutschen die Zuordnungen, sodass dort  "falsche" Namen stehen.

Bin über jede Hilfe dankbar :)

Code:
'Erzeugung des Graphen und Zuweisung der Daten aus dem Tabellenblatt "Gehaltsdaten"

Sub ErzeugungGraph()

   
Dim data As Worksheet
Dim name As Range
Set data = ActiveWorkbook.Worksheets("Gehaltsdaten")

Application.ScreenUpdating = False
Worksheets("Gehaltsdaten").Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=data.Range("A3:AC3000")

ActiveChart.SeriesCollection.NewSeries

   With ActiveChart.SeriesCollection(1)
   
       .XValues = "=Gehaltsdaten!$G$3:$G$800"
       .Values = "=Gehaltsdaten!$AC$3:$AC$800"
       .name = "=Gehaltsdaten!$B$3:$B$800"
       .Trendlines.Add Type:=xlLinear
     
   End With
 
ActiveChart.location Where:=xlLocationAsObject, _
  name:=ThisWorkbook.Worksheets(4).name
 
'Formatierung des Graphen
 
   With ActiveChart
   
       .PlotArea.Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
       .HasLegend = False
       .Parent.Height = 600
       .Parent.Width = 1200
       .HasTitle = True
       .HasTitle = False
       .Axes(xlCategory, xlPrimary).HasTitle = True
       .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Alter"
       .Axes(xlValue, xlPrimary).HasTitle = True
       .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "JEK 35H"
       .Axes(xlValue).MinimumScale = 0
       .Axes(xlCategory).MaximumScale = 80
       .SeriesCollection(1).Format.Fill.ForeColor.RGB = rgbBlue
   
       
   End With
   
Worksheets(4).ChartObjects(1).Activate

With ActiveChart

   .Axes(xlValue).AxisTitle.Font.Size = 20
   .Axes(xlCategory).AxisTitle.Font.Size = 20
   .PlotArea.Interior.ColorIndex = 15
   
End With

'Aufrufen des Programms zur Beschriftung der Datenpunkte

     Call BeschriftungDiagramm
       
End Sub

'Beschriftet die Datenpunkte mit je dem ersten Buchstaben des Nach- und Vornamens

Sub BeschriftungDiagramm()

Dim lngPunkt As Long
Dim data As Worksheet

Set data = ActiveWorkbook.Worksheets("Gehaltsdaten")

  With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
     .ApplyDataLabels
     For lngPunkt = 1 To .Points.Count
        .Points(lngPunkt).DataLabel.Text = Left(data.Cells(lngPunkt + 2, 2), 1) & " " & Mid(data.Cells(lngPunkt + 2, 3), 2, 1)
                 
     Next lngPunkt
     
  End With
 
End Sub

Sub LöschenDiagramm()
   ActiveSheet.ChartObjects(1).Delete
End Sub
Top
#2
Hallo,

wer soll das jetzt nachbauen?
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Top
#3
@Klaus-Dieter

ich möchte wissen, ob jemand eine Idee hat, warum die Zuordnungen zwischen den Datenpunkten und der Beschriftung nicht stimmen. Meintest du, dass zur Problemlösung noch relevante Informationen fehlen?
Ich habe mal die relevanten Spalten der Tabelle angehangen.

Tut mir leid, wenn ich mich missverständlich ausgedrückt habe.


Angehängte Dateien Thumbnail(s)
   
Top
#4
Hat niemand eine Idee?

Ich habe nun versucht mit der Hidden-Eigenschaft zu prüfen, ob die Zeile ein- bzw. ausgeblendet ist, hatte jedoch kein Erfolg dabei.


Code:
Sub XBeschriftungTest()

Dim lngPunkt As Long
Dim data As Worksheet
Dim zeileMax As Integer


Set data = ActiveWorkbook.Worksheets("Gehaltsdaten")
zeileMax = ActiveWorkbook.Worksheets("Gehaltsdaten").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
                                   
  With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
     .ApplyDataLabels
         
     
     For lngPunkt = 1 To zeileMax
     
       If data.Rows(lngPunkt).Hidden = True Then GoTo Ausgeblendet Else GoTo Eingeblendet
       
Eingeblendet:
        .Points(lngPunkt).DataLabel.Text = Left(data.Cells(lngPunkt + 2, 2), 1) & " " & Mid(data.Cells(lngPunkt + 2, 3), 2, 1)
               
     
     
Ausgeblendet:
     Next
     
   
   
  End With
                                   
End Sub
Top
#5
Hallo Jonas,

wo filterst Du in deinem Code?
Gruß Stefan
Win 10 / Office 2016
Top
#6
Hallo,

Zitat:Dim zeileMax As Integer

... bei insgesamt 1.048.576 zur Verfügung stehenden Zeilen wird das wohl kaum mit einem Integer zu erschlagen sein.
Wenn Du trotzdem einen Weg dazu gefunden hast, verrätst Du ihn mir?

Andere Variable haben es offenbar gar nicht erst geschafft, in den erlauchten Kreis der dimensioniert zu werdenden Variablen
aufgenommen zu werden. Auch wurden sie zwar eingeführt, in Folge des Codeablaufes dann aber teilweise nicht einmal abgerufen.
Folglich sind sie wohl absolut überflüssig.

Letztendliich mochte ich Deinem Code gar nicht weiter sezieren ... ist mir zu umständlich.
Top
#7
@Steffl

Kann ich nicht auf die Filterung zurückgreifen, die ich durch die intelligente Tabelle manuell auslöse? Sprich es existiert keine simple Möglichkeit den Code so umzuschreiben, dass anstatt den ungefilterten Daten lediglich die manuell gefilterten Daten betrachtet werden?

@Käpt'n Blaubär

Ich bin ein wenig am verzweifeln und habe rumprobiert, ohne auf eine Lösung zu kommen. Ich habe versucht mit zeileMax mir die Anzahl an eingeblendeten Zeilen anzeigen zu lassen, was ich nicht hinbekommen habe.
Top
#8
Hallo,

Zitat:@Käpt'n Blaubär

Ich bin ein wenig am verzweifeln und habe rumprobiert, ohne auf eine Lösung zu kommen. Ich habe versucht mit zeileMax mir die Anzahl an eingeblendeten Zeilen anzeigen zu lassen, was ich nicht hinbekommen habe.

macht nix, ich habe momentan leider mit mir selbst genug zu tun; aber beim Stefan bist Du gut aufgehoben.
Außerdem gibt es hier im Forum reichlich weitere fähige Helfer. Also viel Erfolg bei Deinem Problem.

Ich habe doch schon geschrieben, daß ein Integer nicht ausreichend sein könnte. Ich kenne ja nur Deinen
Code. Wie hoch kann es denn werden, Dein "ZeileMax"? Versuche es mal mit Long anstatt Integer.
Top
#9
Hallo,

Zitat:Tut mir leid, wenn ich mich missverständlich ausgedrückt habe.
Ich wollte dir empfehlen, die Datei hochzuladen.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Top
#10
Hallo Jonas,

die Anzahl der Punkte im Diagramm werden durch die Filterung vermindert?

@Peter

das mit Long hatte ich Jonas schon in diesem Beitrag geraten. Leider hat er es nicht gelesen oder überlesen. Undecided
Gruß Stefan
Win 10 / Office 2016
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste