Office: (Office 365) Datenreihe Dynamisch

Hallo Zusammen,

in meiner Datei sind zwei Sheets.Sheet OEE_04_2021 und Diagramme.
Aus den Werten des Sheet OEE_04_2021 hole ich mir Daten für die Diagramme.

Nun wechselt am 01.05.2021 das Sheet in OEE_05_2021 ,also auf Mai.
Dann sind meine Daten auf "Diagramme" alle weg . Weil ja in der Datenreihe OEE_04_2021 steht.
Wie kann man es machen das der Name des Sheet OEE geändert werden kann,aber die Werte auf Diagramme vom neuen Sheet übernommen werden?

 

Hi,

also wenn du den Namen des Tabellenblattes OEE_04_2021 änderst in OEE_05_2021 bleibt der Bezug der Diagramme zu diesem Tabellenbatt doch erhalten und die neuen Daten werden in den Diagrammen angezeigt - ich verstehe also leider dein Problem nicht. Oder meinst du, du erstellst im Mai ein NEUES Tabellenblatt und möchtest die Diagramme auf dieses NEUE Blatt beziehen? Das ist aber etwas völlig anderes als was du in deinem Beitrag schreibst.

---

 

Hallo,
das Tabellenblatt wird ausgeblendet und ein neues für Mai erstellt. Das heißt dann OEE_05_2021 .
Hatte ich wohl vergessen zu beschreiben.

 

Hi,

es gibt 2 Möglichkeiten mit jeweils folgenden Schritten:

1. kopiere das OEE_04_2021 -> benenne das ursprüngliche OEE_04_2021 um in OEE_05_2021 und lösche dort alle Daten, damit du neue eintragen kannst -> benenne das kopierte Tabellenblatt zurück in OEE_04_2021. Dadurch bleiben die Bezüge der Diagramme immer auf das Ursprungsblatt erhalten.

2. erstelle ein eues Tabellenlatt OEE_05_2021 (wie auch immer du das machen willst) -> ändere die Bezüge in den Diagrammen auf das neue Tabellenblatt.

Beides kann man problemlos per VBA realisieren.

---

 

Hallo Karin,
das neue Datenblatt wird bereits am ersten jenden Monats automatisch erstellt.
Dann müssten nur die Bezüge automatisch angepasst werden.

 

Hallo,
habe 24 Diagramme.
Würde gerne in eine Zelle den Neuen Monat eintragen. Also z.B OEE_05_2021 und ein Makro benennt mir alle Diagramme in den neuen Monat um.
Leider bin ich da auf Hilfe angewiesen.

=DATENREIHE(OEE_04_2021!$CV$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CV$6:$CV$98;1)
=DATENREIHE(OEE_04_2021!$CW$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CW$6:$CW$98;2)
=DATENREIHE(OEE_04_2021!$CX$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CX$6:$CX$98;3)
=DATENREIHE(OEE_04_2021!$CY$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CY$6:$CY$98;4)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;5)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;6)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;7)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;8)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;9)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;10)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;11)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;12)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;13)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;14)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;15)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;16)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;17)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;18)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;19)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;20)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;21)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;22)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;23)
=DATENREIHE(OEE_04_2021!$CZ$5;OEE_04_2021!$CT$6:$CU$98;OEE_04_2021!$CZ$6:$CZ$98;24)

 

Hi,

und wie wird das neue Blatt erstellt - per VBA? Dann poste doch mal den Code, denn dort müsste man auch gleich den Code für das Anpassen der Diagrammbezüge einbinden, damit alles zusammen realisiert werden kann.

---

 

Hi,
hier der Code.

Code:

Option Explicit

Sub Uebertrage_OEE()
 Dim iZeile As Long, iOutZeile As Long, iOutSpalte As Integer, iMax As Integer
 Dim iTag As Integer, iSpalte As Integer, iFromZeile As Long, iBeginn As Long
 Dim sDateiPfad As String, sDatei As String, sPfad As String, sBlatt As String
 Dim sArr() As String, sArrSp() As String, sRange As String, sQuelle As String
 Dim WSh As Worksheet, T As String, j
 j = Timer
 ActiveSheet.Unprotect Password:="XXXXXXX"
 Application.StatusBar = "Auswertung beginnt"
 
 sBlatt = "OEE_" & Mid$(Date, 4, 2) & "_" & Right(Date, 4)       'Blattnamen ermitteln
 On Error Resume Next
 Set WSh = ThisWorkbook.Sheets(sBlatt)                            'Zielblatt
 If Err <> 0 Then
'Neues Blatt anlegen, weil es nicht da ist
    Sheets("OEE_Muster").Copy Before:=Sheets(1)
    Set WSh = ThisWorkbook.Sheets(1)                              'Zielblatt
    WSh.Name = sBlatt
    WSh.Rows("4:" & WSh.Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
    sArr = Split(WSh.Name, "_")                                   '1. Tag setzen
    WSh.Range("A1") = "01." & sArr(1) & "." & sArr(UBound(sArr))
    WSh.Range("A4").Select
    WSh.Calculate
 End If
 
 WSh.Select
 sArrSp = Split(" J S AB")                                        'Quellspalten ggf. anpassen
 sBlatt = "täglicheEingaben"                                      'Quellblatt
 
 On Error GoTo Fehler
 iOutZeile = 4                                                    'Ausgabe ab Zeile 4
 
 With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
  .EnableEvents = False
 End With
 
 
 iBeginn = Val(Left$(Date, 2)) - 4                         'X Tage rückwärts aktuaisieren
 If iBeginn < 1 Then iBeginn = 1
 iMax = WSh.Cells(Rows.Count, "A").End(xlUp).Row - 3
 If iMax = 0 Then iMax = 1
 iMax = 3 * (Val(Left$(Date, 2)) - iBeginn) * iMax
 ProzessDlg.FSUF 0, iMax, "Beginn der Aktualisierung", "Übersicht aktualisieren"
 
 For iZeile = 1 To Referenz.Cells(Rows.Count, "A").End(xlUp).Row
  sDateiPfad = Referenz.Cells(iZeile, "A").Value                  'Vollständiger Dateipfad
  
  If Dir$(sDateiPfad) <> "" Then                                  'Ist die Datei vorhanden?
     sArr = Split(sDateiPfad, "\")
     sDatei = sArr(UBound(sArr))                                  'Quelldatei
     sPfad = Left$(sDateiPfad, Len(sDateiPfad) - Len(sDatei))
     sQuelle = "'" & sPfad & "[" & sDatei & "]" & sBlatt & "'!"
    
'Dateinamen suchen, Zeile merken oder hinten anfügen
     If GetMatch(sDatei, WSh, "A", iOutZeile) = 0 Then           'Dateinamen suchen
        iOutZeile = WSh.Cells(Rows.Count, "A").End(xlUp).Row + 1 'Erste freie Zeile
        WSh.Cells(iOutZeile, "A").Value = sDatei                 'Dateinamen schreiben
     End If
    
'Jetzt die Daten holen geändert
'iBeginn = 1
     iFromZeile = 25 + ((iBeginn - 1) * 35)
     iOutSpalte = (iBeginn * 3) - 1
     For iTag = iBeginn To 31
       If Left$(WSh.Cells(2, iOutSpalte).Value, 2) > Left$(Date, 2) Then
          Exit For                                               'Keine Datenermittlung in Zukunft
       End If
       For iSpalte = 1 To UBound(sArrSp)                         'Alle gewünschten Spalten durchgehen
          sRange = Cells(iFromZeile, sArrSp(iSpalte)).Address
          WSh.Cells(iOutZeile, iOutSpalte).Value = _
              ExecuteExcel4Macro(sQuelle _
              & Range(sRange).Range("A1").Address(, , xlR1C1))  'Daten aus geschlossener Datei holen
              iOutSpalte = iOutSpalte + 1
              T = CStr(iTag): If iTag < 10 Then T = "  " & iTag
              ProzessDlg.FSUF 1, 1, T & ".Tag wird übernommen", sDatei
       Next iSpalte
       iFromZeile = iFromZeile + 35                             'nächsten Tag anspringen
     Next iTag
  End If
 
 Next iZeile
 
 With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
  .EnableEvents = True
 End With
 Application.StatusBar = "Fertig in " & Str$(Timer - j)
 ProzessDlg.FSUF 3
 ThisWorkbook.Save
 
 'Application.OnTime Now + TimeValue("01:00:00"), "Uebertrage_OEE"   'Neulauf nach einer Stunde
  ActiveSheet.Protect Password:="XXXXXXX", UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
 Exit Sub
 

Fehler:
 MsgBox "Es ist der Fehler " & vbCr & Error & vbCr & " aufgetreten!", vbCritical, "Fehler"
 ProzessDlg.FSUF 3
 
End Sub

Function GetMatch(Such As String, WkB As Object, ZlSp As String, Optional Fundort As Long) As Long
'Funktion ermittelt die Zeile bzw. die Spalte, in der sich der Suchbegriff befindet
 Dim ZS As String
 
 On Error Resume Next
 ZS = ZlSp: If Not ZS Like "*:*" Then ZS = ZS & ":" & ZS
 With Range(ZS)
   GetMatch = Application.WorksheetFunction.Match(Such, WkB.Range(ZS), 0)   'Suchbegriff suchen
   If ZlSp Like "*:*" And GetMatch <> 0 Then
      If .Rows.Count = 1 Then
          GetMatch = GetMatch + .Column - 1                                 'Range-Beginn Spalte dazurechnen
      ElseIf .Columns.Count = 1 Then
          GetMatch = GetMatch + .Row - 1                                    'Range-Beginn Zeile dazurechnen
      End If
   End If
   Fundort = GetMatch
 End With

End Function

 

Hi,

du zeigst in deinen Diagrammen immer nur 1 Datenreihe an, hast aber zusätzlich noch mehrere ausgeblendete Datenreihen - wozu? Wenn du nur 1 Datenreihe anzeigen willst brauchst du doch auch nur 1 einzige im Diagramm - die restlichen sind etwas sinnlos. Diese ausgeblendeten Datenreihen behindern/vereiteln nämlich außerdem das Ändern der Datenreihenbezüge, weil sie erst eingeblendet werden müssen um die Änderung durchzuführen und dann wieder ausgeblendet werden müssen. Das Ändern der Bezüge per VBA braucht aufgrund der Vielzahl an Diagrammen schon sehr lange, durch die ausgeblendeten Datenreihen bräuchte er jedoch noch sehr viel länger. Außerdem schafft es Excel dadurch teilweise nicht, die Änderungen an allen Datenreihen durchzuführen. Lösche doch einfach die Datenreihen, die nicht angezeigt werden sollen und erstelle die Diagramme jeweils nur für die zutreffende 1 Spalte deiner Daten. Hier mal ein Makro zum Löschen der ausgeblendeten Datenreihen:

Code:

Sub DiasReihenLoeschen()
    Dim chrDia As ChartObject
    Dim intReihe As Integer
    With Worksheets("Diagramme")
        For Each chrDia In .ChartObjects
            With chrDia.Chart
                For intReihe = .FullSeriesCollection.Count To 1 Step -1
                    If .FullSeriesCollection(intReihe).IsFiltered Then
                        .FullSeriesCollection(intReihe).Delete
                    End If
                Next intReihe
            End With
        Next chrDia
    End With
End Sub

Nachdem du ihn ausgeführt hast, hat jedes Diagramm dann nur noch 1 Datenreihe mit Bezug zu der betreffnden Spalte.

Anschließend kannst du folgendes Makro zum Anpassen der Diagrammbezüge verwenden:

Code:

Sub DiasAnpassen()
    Dim chrDia As ChartObject
    Dim strTab As String
    Dim strNeu As String
    Dim strFormel As String
    strNeu = Worksheets(1).Name & "!"
    With Worksheets("Diagramme")
        For Each chrDia In .ChartObjects
            With chrDia.Chart
                strFormel = .FullSeriesCollection(1).Formula
                strTab = Split(strFormel, ",")(1)
                strTab = Left(strTab, InStr(strTab, "!"))
                strFormel = Application.Substitute(strFormel, strTab, strNeu)
                .FullSeriesCollection(1).Formula = strFormel
            End With
        Next chrDia
    End With
End Sub

In deinen Code zum Erstellen des neuen Tabellenblattes kannst du das Makro wie folgt einbinden:

Code:

 If Err <> 0 Then
'Neues Blatt anlegen, weil es nicht da ist
    Sheets("OEE_Muster").Copy Before:=Sheets(1)
    Set WSh = ThisWorkbook.Sheets(1)                              'Zielblatt
    WSh.Name = sBlatt
    WSh.Rows("4:" & WSh.Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
    sArr = Split(WSh.Name, "_")                                   '1. Tag setzen
    WSh.Range("A1") = "01." & sArr(1) & "." & sArr(UBound(sArr))
    WSh.Range("A4").Select
    WSh.Calculate
    DiasAnpassen  '<== Makro zum Ändern der Diagrammbezüge starten
 End If

Es wird also einfach aufgerufen, wenn das neue Tabellenblatt erstellt wurde.

---

 

Karin...........Herzlichen Danke für Deine Hilfe

 

Gern geschehen.

---