AW: Diagramm Mehrfachnennungen zusammen fassen
24.03.2021 08:23:11
Beverly
Hi Andreas,
das kann man mit einem Makro lösen, indem man die gefilterten Daten in ein zusätzliches Tabellenblatt kopiert, in einer Schleife über alle kopierten Einträge läuft und alle doppelten löscht. Das Diagramm bezieht man dann auf diese Hilfstabelle, die jeden Eintrag nur noch einmalig enthält:
Sub DiaBearbeiten()
Dim lngZeilen As Long
Dim lngLetzte As Long
Dim lngZaehler As Long
Dim chrDia As Chart
Dim serReihe As Series
Dim rngBereich As Range
' Bildschirmaktualisierung aus
Application.ScreenUpdating = False
' Tabelle1 leeren
Worksheets("Tabelle1").Cells.ClearContents
With Worksheets("Anwendung")
' letzte Zeile an Daten ermitteln
lngLetzte = .ListObjects(1).DataBodyRange.Rows.Count + 16
' Spalten P:Q sichtbare Zellen nach Tabelle1 kopieren
.Range(.Cells(17, 16), .Cells(lngLetzte, 18)).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Tabelle1").Range("A1")
' Anzahl an sichtbaren Zeilen ermitteln
lngZeilen = .ListObjects(1).DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible). _
Count
With Worksheets("Tabelle1")
' Schleife über alle Zeilen und alle doppelten Einträge zu eliminieren
For lngZaehler = lngZeilen To 1 Step -1
' Anzahl der laufenden Zelle > 1 dann Zelle leeren
If Application.CountIf(.Range(.Cells(1, 1), .Cells(lngZaehler, 1)), .Cells( _
lngZaehler, 1)) > 1 Then _
.Range(.Cells(lngZaehler, 1), .Cells(lngZaehler, 1)).ClearContents
Next lngZaehler
' leere Zeilen löschen
.Range(.Cells(1, 1), .Cells(lngZeilen + 1, 1)).SpecialCells(xlCellTypeBlanks). _
EntireRow.Delete
lngZaehler = Application.CountA(.Columns(1))
' Bereich für Diagramm festlegen
Set rngBereich = Union(.Range(.Cells(1, 1), .Cells(lngZaehler, 1)), .Range(.Cells(1, _
3), .Cells(lngZaehler, 3)))
End With
' bezogen auf das Diagramm
With .ChartObjects(1).Chart
' Datenbereich zuweisen
.SetSourceData Source:=rngBereich
End With
End With
' Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub
Es ist vom Prinzip her derselbe Ablauf, wie ich dir bereits in diesem Beitrag https://www.herber.de/forum/archiv/1820to1824/t1821435.htm#1821435
vorgeschlagen hatte, nur dass es dort um das Ausblenden von Rubriken unter bestimmten Bedingungen im Diagramm ging.
