sehr dynamisches Diagramm
Hallo Andreas,
http://www.file-upload.net/download-8413578/DiagDisk…
Kannst es dir ja mal anschauen und wenn du es für gut
befindest, hier posten.
deine Änderungen sind sehr okay. Da ja Bemerkungen von dir im Code auf meinen Vorgängercode beziehen hae ich die liquidiert da sie ohne das zu wissen andere irritieren.
Wenn man an der
Tabelle was ändert bevor die Diagramme erstellt sind, gibts
einen „Index außerhalb des gültigen Bereichs“ in der Zeile
„With Charts(Namen(N))“ in „Sub Aktualisiere()“. Ist auch
klar. Evtl. zu Beginn der Routine abfragen, ob schon Diagramme
existieren.
Ist bereinigt bzw. integriert.
Man könnte auch noch darüber nachdenken, die Blattnamen und
die Auswahlkriterien flexibler zu gestalten; vielleicht durch
Eintragen in ein Hilfsblatt. Aber da kann man sich beleibig
verkünsteln.
„beleibig“? Jawoll, das passt sehr zu kommenden Festtagen in Folge 
)
Was du vorschlägst ginge natürlich aber ich sehe da keinen Handlungsbedarf alles was da möglich wäre auch zu machen. Sehe es realistisch, versuche mal meine deine Uploads downzuladen, dann kannste ja leicht das hier vorhandene Interesse einschätzen da ja da die Anzahl der Downloadzeil angezeigt wird 
Was völlig anderes ist es wenn jmd. nachfragt wie er dies oder jenes „einbauen“ könnte.
Nachfolgend unser Code
Gruß
Reinhard
Wenn der Link zu der Datei nicht mehr funktioniert:
Legende:
Blatt Tabelle1 hat dreispältige Tabelle in A:C.
In A stehen Bezeichnungen.
In B steht entweder 90 oder 0 oder nix.
In C stehen Messwerte.
Aufgabe:
Code basteln der aus diesen Rohdaten vier Diagrammblätter erstellt. Diagrammtyp „Säule“.
Diagramm1: alle A-Werte als x und alle C-Werte als y.
Diagramm2: nur A-Werte als x und nur C-Werte als y wo in B die 90 steht
Diagramm3: nur A-Werte als x und nur C-Werte als y wo in B die 0 steht
Diagramm4: nur A-Werte als x und nur C-Werte als y wo in B nix steht
Das ganze vollautomatisch aktualisiert bei jedweder Änderung von Zellen in A:C.
Lösungscode von Andreas und mir:
PS: Kann uns beiden ein guter Excelianer weiterhelfen bei der „Warum“-Frage die im Code steht?
Im Modul von Tabelle1:
Option Explicit
Private Sub Worksheet\_Change(ByVal Target As Range)
Dim N As Integer, Namen, Sh, Anz As Integer
Namen = Array("DiagAlle", "DiagOhne", "DiagNull", "Diag90")
Set Target = Intersect(Target, Range("A:C"))
If Target Is Nothing Then Exit Sub
For N = LBound(Namen) To UBound(Namen)
For Each Sh In ThisWorkbook.Sheets
If Sh.Name = Namen(N) Then Anz = Anz + 1
Next Sh
Next N
If Anz 4 Then Call Erstelle
If Cells(Target.Row, 1) "" And Cells(Target.Row, 3) "" Then
Call Aktualisiere
End If
End Sub
In ein Standardmodul:
Option Explicit
Option Base 1
Sub Aktualisiere()
Dim N As Integer, Namen
Namen = Array("DiagAlle", "DiagOhne", "DiagNull", "Diag90")
For N = LBound(Namen) To UBound(Namen)
With Charts(Namen(N))
.SetSourceData Source:=Bereich(N), PlotBy:=xlColumns
If .SeriesCollection.Count \> 1 Then .SeriesCollection(1).Delete
End With
Next N
End Sub
Sub Erstelle()
Dim Diag, N As Integer, Namen
Namen = Array("DiagAlle", "DiagOhne", "DiagNull", "Diag90")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Diag In Sheets
If Diag.Name Like "Diag\*" Then Diag.Delete
Next Diag
Application.DisplayAlerts = True
For N = LBound(Namen) To UBound(Namen)
' klappt nicht mit .Add After:=..., egal sheet oder worksheet,
' neues Blatt beibt erstes Blatt, erst mit .Move after:=... klappts. Warum???
Charts.Add after:=Sheets(Sheets.Count)
With ActiveChart
.Move after:=Sheets(Sheets.Count) ' mit dieser Krücke geht's dann.
.Name = Namen(N)
.ChartType = xlColumnClustered
.SetSourceData Source:=Bereich(N), PlotBy:=xlColumns
If .SeriesCollection.Count \> 1 Then .SeriesCollection(1).Delete
.SeriesCollection(1).Interior.ColorIndex = 37
.SeriesCollection(1).Name = .Name & " Messwerte"
.Location Where:=xlLocationAsNewSheet
End With
Next N
Application.ScreenUpdating = True
End Sub
Function Bereich(ByVal N As Integer) As Range
Dim Zei As Long, Z As Long, Kriterium
Kriterium = Array("alle", "", 0, 90)
With Worksheets("Tabelle1")
Zei = .Cells(.Rows.Count, 1).End(xlUp).Row
Select Case N
Case 1 ' "DiagAlle"
Set Bereich = Union(.Range("A2:A" & Zei), .Range("C2:C" & Zei))
Case 2 To 4 ' Alle anderen Diags
For Z = 2 To Zei
If CStr(.Cells(Z, 2).Value) = CStr(Kriterium(N)) Then
If Not Bereich Is Nothing Then
Set Bereich = Union(Bereich, .Range("A" & Z, "C" & Z))
Else
Set Bereich = .Range("A" & Z, "C" & Z)
End If
End If
Next Z
Case Else
'nix
End Select
End With
End Function
